--- loncom/lonnet/perl/lonnet.pm	2006/10/20 20:39:44	1.782.2.4
+++ loncom/lonnet/perl/lonnet.pm	2006/10/30 11:10:51	1.801
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.782.2.4 2006/10/20 20:39:44 albertel Exp $
+# $Id: lonnet.pm,v 1.801 2006/10/30 11:10:51 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,6 +52,7 @@ use Storable qw(lock_store lock_nstore l
 use Time::HiRes qw( gettimeofday tv_interval );
 use Cache::Memcached;
 use Digest::MD5;
+use Math::Random;
 use lib '/home/httpd/lib/perl';
 use LONCAPA;
 use LONCAPA::Configuration;
@@ -292,6 +293,34 @@ sub error {
     return undef;
 }
 
+sub convert_and_load_session_env {
+    my ($lonidsdir,$handle)=@_;
+    my @profile;
+    {
+	open(my $idf,"$lonidsdir/$handle.id");
+	flock($idf,LOCK_SH);
+	@profile=<$idf>;
+	close($idf);
+    }
+    my %temp_env;
+    foreach my $line (@profile) {
+	if ($line !~ m/=/) {
+	    return 0;
+	}
+	chomp($line);
+	my ($envname,$envvalue)=split(/=/,$line,2);
+	$temp_env{&unescape($envname)} = &unescape($envvalue);
+    }
+    unlink("$lonidsdir/$handle.id");
+    if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_WRCREAT(),
+	    0640)) {
+	%disk_env = %temp_env;
+	@env{keys(%temp_env)} = @disk_env{keys(%temp_env)};
+	untie(%disk_env);
+    }
+    return 1;
+}
+
 # ------------------------------------------- Transfer profile into environment
 my $env_loaded;
 sub transfer_profile_to_env {
@@ -305,30 +334,36 @@ sub transfer_profile_to_env {
         ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
     }
 
-    my @profile;
+    my $convert;
     {
-	open(my $idf,"$lonidsdir/$handle.id");
+    	open(my $idf,"$lonidsdir/$handle.id");
 	flock($idf,LOCK_SH);
-	@profile=<$idf>;
-	close($idf);
+	if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+		&GDBM_READER(),0640)) {
+	    @env{keys(%disk_env)} = @disk_env{keys(%disk_env)};
+	    untie(%disk_env);
+	} else {
+	    $convert = 1;
+	}
     }
-    my $envi;
-    my %Remove;
-    for ($envi=0;$envi<=$#profile;$envi++) {
-	chomp($profile[$envi]);
-	my ($envname,$envvalue)=split(/=/,$profile[$envi],2);
-	$envname=&unescape($envname);
-	$envvalue=&unescape($envvalue);
-	$env{$envname} = $envvalue;
+    if ($convert) {
+	if (!&convert_and_load_session_env($lonidsdir,$handle)) {
+	    &logthis("Failed to load session, or convert session.");
+	}
+    }
+
+    my %remove;
+    while ( my $envname = each(%env) ) {
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
-                $Remove{$key}++;
+                $remove{$key}++;
             }
         }
     }
+
     $env{'user.environment'} = "$lonidsdir/$handle.id";
     $env_loaded=1;
-    foreach my $expired_key (keys(%Remove)) {
+    foreach my $expired_key (keys(%remove)) {
         &delenv($expired_key);
     }
 }
@@ -347,54 +382,13 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    foreach my $key (keys(%newenv)) {
-	my $value = &escape($newenv{$key});
-	delete($newenv{$key});
-	$newenv{&escape($key)}=$value;
-    }
-
-    my $lockfh;
-    unless (open($lockfh,"$env{'user.environment'}")) {
-	return 'error: '.$!;
-    }
-    unless (flock($lockfh,LOCK_EX)) {
-         &logthis("<font color=\"blue\">WARNING: ".
-                  'Could not obtain exclusive lock in appenv: '.$!);
-         close($lockfh);
-         return 'error: '.$!;
-    }
-
-    my @oldenv;
-    {
-	my $fh;
-	unless (open($fh,"$env{'user.environment'}")) {
-	    return 'error: '.$!;
-	}
-	@oldenv=<$fh>;
-	close($fh);
-    }
-    for (my $i=0; $i<=$#oldenv; $i++) {
-        chomp($oldenv[$i]);
-        if ($oldenv[$i] ne '') {
-	    my ($name,$value)=split(/=/,$oldenv[$i],2);
-	    unless (defined($newenv{$name})) {
-		$newenv{$name}=$value;
-	    }
-        }
-    }
-    {
-	my $fh;
-	unless (open($fh,">$env{'user.environment'}")) {
-	    return 'error';
-	}
-	my $newname;
-	foreach $newname (keys %newenv) {
-	    print $fh $newname.'='.$newenv{$newname}."\n";
+    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
+	    0640)) {
+	while (my ($key,$value) = each(%newenv)) {
+	    $disk_env{$key} = $value;
 	}
-	close($fh);
+	untie(%disk_env);
     }
-	
-    close($lockfh);
     return 'ok';
 }
 # ----------------------------------------------------- Delete from Environment
@@ -406,47 +400,33 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    my @oldenv;
-    {
-	my $fh;
-	unless (open($fh,"$env{'user.environment'}")) {
-	    return 'error';
-	}
-	unless (flock($fh,LOCK_SH)) {
-	    &logthis("<font color=\"blue\">WARNING: ".
-		     'Could not obtain shared lock in delenv: '.$!);
-	    close($fh);
-	    return 'error: '.$!;
-	}
-	@oldenv=<$fh>;
-	close($fh);
-    }
-    {
-	my $fh;
-	unless (open($fh,">$env{'user.environment'}")) {
-	    return 'error';
-	}
-	unless (flock($fh,LOCK_EX)) {
-	    &logthis("<font color=\"blue\">WARNING: ".
-		     'Could not obtain exclusive lock in delenv: '.$!);
-	    close($fh);
-	    return 'error: '.$!;
-	}
-	foreach my $cur_key (@oldenv) {
-	    my $unescaped_cur_key = &unescape($cur_key);
-	    if ($unescaped_cur_key=~/^$delthis/) { 
-                my ($key) = split('=',$cur_key,2);
-		$key = &unescape($key);
+    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
+	    0640)) {
+	foreach my $key (keys(%disk_env)) {
+	    if ($key=~/^$delthis/) { 
                 delete($env{$key});
-            } else {
-                print $fh $cur_key; 
+                delete($disk_env{$key});
             }
 	}
-	close($fh);
+	untie(%disk_env);
     }
     return 'ok';
 }
 
+sub get_env_multiple {
+    my ($name) = @_;
+    my @values;
+    if (defined($env{$name})) {
+        # exists is it an array
+        if (ref($env{$name})) {
+            @values=@{ $env{$name} };
+        } else {
+            $values[0]=$env{$name};
+        }
+    }
+    return(@values);
+}
+
 # ------------------------------------------ Find out current server userload
 # there is a copy in lond
 sub userload {
@@ -556,10 +536,10 @@ sub compare_server_load {
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
-    my ($uname,$udom,$currentpass,$newpass,$server)=@_;
+    my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);
-    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass",
+    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
 		       $server);
     if (! $answer) {
 	&logthis("No reply on password change request to $server ".
@@ -684,8 +664,8 @@ sub idget {
 sub idrget {
     my ($udom,@unames)=@_;
     my %returnhash=();
-    foreach (@unames) {
-        $returnhash{$_}=(&userenvironment($udom,$_,'id'))[1];
+    foreach my $uname (@unames) {
+        $returnhash{$uname}=(&userenvironment($udom,$uname,'id'))[1];
     }
     return %returnhash;
 }
@@ -695,22 +675,22 @@ sub idrget {
 sub idput {
     my ($udom,%ids)=@_;
     my %servers=();
-    foreach (keys %ids) {
-	&cput('environment',{'id'=>$ids{$_}},$udom,$_);
-        my $uhom=&homeserver($_,$udom);
+    foreach my $uname (keys(%ids)) {
+	&cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
+        my $uhom=&homeserver($uname,$udom);
         if ($uhom ne 'no_host') {
-            my $id=&escape($ids{$_});
+            my $id=&escape($ids{$uname});
             $id=~tr/A-Z/a-z/;
-            my $unam=&escape($_);
+            my $esc_unam=&escape($uname);
 	    if ($servers{$uhom}) {
-		$servers{$uhom}.='&'.$id.'='.$unam;
+		$servers{$uhom}.='&'.$id.'='.$esc_unam;
             } else {
-                $servers{$uhom}=$id.'='.$unam;
+                $servers{$uhom}=$id.'='.$esc_unam;
             }
         }
     }
-    foreach (keys %servers) {
-        &critical('idput:'.$udom.':'.$servers{$_},$_);
+    foreach my $server (keys(%servers)) {
+        &critical('idput:'.$udom.':'.$servers{$server},$server);
     }
 }
 
@@ -878,9 +858,9 @@ sub getsection {
     # If there is more than one expired role, choose the one which ended last.
     # If there is a role which has expired, return it.
     #
-    foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
-                        &homeserver($unam,$udom)))) {
-        my ($key,$value)=split(/\=/,$_);
+    foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+					&homeserver($unam,$udom)))) {
+        my ($key,$value)=split(/\=/,$line,2);
         $key=&unescape($key);
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;
@@ -1656,7 +1636,14 @@ sub removeuploadedurl {
 sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;
     my $home=&homeserver($docuname,$docudom);
-    return &reply("removeuserfile:$docudom/$docuname/$fname",$home);
+    my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home);
+    if ($result eq 'ok') {
+        if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
+            my $metafile = $fname.'.meta';
+            my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
+        }
+    }
+    return $result;
 }
 
 sub mkdiruserfile {
@@ -1668,8 +1655,17 @@ sub mkdiruserfile {
 sub renameuserfile {
     my ($docuname,$docudom,$old,$new)=@_;
     my $home=&homeserver($docuname,$docudom);
-    return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'.
-		  &escape("$new"),$home);
+    my $result = &reply("renameuserfile:$docudom:$docuname:".
+                        &escape("$old").':'.&escape("$new"),$home);
+    if ($result eq 'ok') {
+        if (($old !~ /\.meta$/) && (&is_portfolio_file($old))) {
+            my $oldmeta = $old.'.meta';
+            my $newmeta = $new.'.meta';
+            my $metaresult = 
+                &renameuserfile($docuname,$docudom,$oldmeta,$newmeta);
+        }
+    }
+    return $result;
 }
 
 # ------------------------------------------------------------------------- Log
@@ -1695,8 +1691,7 @@ sub flushcourselogs {
 # times and course titles for all courseids
 #
     my %courseidbuffer=();
-    foreach (keys %courselogs) {
-        my $crsid=$_;
+    foreach my $crsid (keys %courselogs) {
         if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
 		          &escape($courselogs{$crsid}),
 		          $coursehombuf{$crsid}) eq 'ok') {
@@ -1723,8 +1718,8 @@ sub flushcourselogs {
 # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse
 #
-    foreach (keys %courseidbuffer) {
-        &courseidput($hostdom{$_},$courseidbuffer{$_},$_);
+    foreach my $crsid (keys(%courseidbuffer)) {
+        &courseidput($hostdom{$crsid},$courseidbuffer{$crsid},$crsid);
     }
 #
 # File accesses
@@ -1765,8 +1760,7 @@ sub flushcourselogs {
 # Roles
 # Reverse lookup of user roles for course faculty/staff and co-authorship
 #
-    foreach (keys %userrolehash) {
-        my $entry=$_;
+    foreach my $entry (keys(%userrolehash)) {
         my ($role,$uname,$udom,$runame,$rudom,$rsec)=
 	    split(/\:/,$entry);
         if (&Apache::lonnet::put('nohist_userroles',
@@ -1838,9 +1832,9 @@ sub courseacclog {
     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
         $what.=':POST';
         # FIXME: Probably ought to escape things....
-	foreach (keys %env) {
-            if ($_=~/^form\.(.*)/) {
-		$what.=':'.$1.'='.$env{$_};
+	foreach my $key (keys(%env)) {
+            if ($key=~/^form\.(.*)/) {
+		$what.=':'.$1.'='.$env{$key};
             }
         }
     } elsif ($fnsymb =~ m:^/adm/searchcat:) {
@@ -1902,19 +1896,19 @@ sub get_course_adv_roles {
     $cid=$env{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);
     my %nothide=();
-    foreach (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
-	$nothide{join(':',split(/[\@\:]/,$_))}=1;
+    foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
+	$nothide{join(':',split(/[\@\:]/,$user))}=1;
     }
     my %returnhash=();
     my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
     my $now=time;
-    foreach (keys %dumphash) {
-	my ($tend,$tstart)=split(/\:/,$dumphash{$_});
+    foreach my $entry (keys %dumphash) {
+	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
         if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }
-        my ($role,$username,$domain,$section)=split(/\:/,$_);
+        my ($role,$username,$domain,$section)=split(/\:/,$entry);
 	if ($username eq '' || $domain eq '') { next; }
 	if ((&privileged($username,$domain)) && 
 	    (!$nothide{$username.':'.$domain})) { next; }
@@ -1938,12 +1932,12 @@ sub get_my_roles {
             &dump('nohist_userroles',$udom,$uname);
     my %returnhash=();
     my $now=time;
-    foreach (keys %dumphash) {
-	my ($tend,$tstart)=split(/\:/,$dumphash{$_});
+    foreach my $entry (keys(%dumphash)) {
+	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
         if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }
-        my ($role,$username,$domain,$section)=split(/\:/,$_);
+        my ($role,$username,$domain,$section)=split(/\:/,$entry);
 	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
      }
     return %returnhash;
@@ -1964,7 +1958,7 @@ sub getannounce {
 
     if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
 	my $announcement='';
-	while (<$fh>) { $announcement .=$_; }
+	while (my $line = <$fh>) { $announcement .= $line; }
 	close($fh);
 	if ($announcement=~/\w/) { 
 	    return 
@@ -1988,18 +1982,18 @@ sub courseidput {
 }
 
 sub courseiddump {
-    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter)=@_;
+    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
     my %returnhash=();
     unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {
         if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
 	    if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
-	        foreach (
+	        foreach my $line (
                  split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
 			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter),
+                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
                                $tryserver))) {
-		    my ($key,$value)=split(/\=/,$_);
+		    my ($key,$value)=split(/\=/,$line,2);
                     if (($key) && ($value)) {
 		        $returnhash{&unescape($key)}=$value;
                     }
@@ -2028,8 +2022,8 @@ sub dcmaildump {
                                                          &escape($enddate).':';
 	my @esc_senders=map { &escape($_)} @$senders;
 	$cmd.=&escape(join('&',@esc_senders));
-	foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
-            my ($key,$value) = split(/\=/,$_);
+	foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+            my ($key,$value) = split(/\=/,$line,2);
             if (($key) && ($value)) {
                 $returnhash{&unescape($key)} = &unescape($value);
             }
@@ -2052,11 +2046,11 @@ sub get_domain_roles {
     foreach my $tryserver (keys(%libserv)) {
         if ($hostdom{$tryserver} eq $dom) {
             %{$personnel{$tryserver}}=();
-            foreach (
+            foreach my $line (
                 split(/\&/,&reply('domrolesdump:'.$dom.':'.
                    &escape($startdate).':'.&escape($enddate).':'.
                    &escape($rolelist), $tryserver))) {
-                my($key,$value) = split(/\=/,$_);
+                my ($key,$value) = split(/\=/,$line,2);
                 if (($key) && ($value)) {
                     $personnel{$tryserver}{&unescape($key)} = &unescape($value);
                 }
@@ -2070,7 +2064,7 @@ sub get_domain_roles {
 
 sub get_first_access {
     my ($type,$argsymb)=@_;
-    my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+    my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') {
@@ -2084,7 +2078,7 @@ sub get_first_access {
 
 sub set_first_access {
     my ($type)=@_;
-    my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+    my ($symb,$courseid,$udom,$uname)=&whichuser();
     my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') {
 	$res=&symbread($map);
@@ -2278,27 +2272,27 @@ sub hash2str {
 sub hashref2str {
   my ($hashref)=@_;
   my $result='__HASH_REF__';
-  foreach (sort(keys(%$hashref))) {
-    if (ref($_) eq 'ARRAY') {
-      $result.=&arrayref2str($_).'=';
-    } elsif (ref($_) eq 'HASH') {
-      $result.=&hashref2str($_).'=';
-    } elsif (ref($_)) {
+  foreach my $key (sort(keys(%$hashref))) {
+    if (ref($key) eq 'ARRAY') {
+      $result.=&arrayref2str($key).'=';
+    } elsif (ref($key) eq 'HASH') {
+      $result.=&hashref2str($key).'=';
+    } elsif (ref($key)) {
       $result.='=';
-      #print("Got a ref of ".(ref($_))." skipping.");
+      #print("Got a ref of ".(ref($key))." skipping.");
     } else {
-	if ($_) {$result.=&escape($_).'=';} else { last; }
+	if ($key) {$result.=&escape($key).'=';} else { last; }
     }
 
-    if(ref($hashref->{$_}) eq 'ARRAY') {
-      $result.=&arrayref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_}) eq 'HASH') {
-      $result.=&hashref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_})) {
+    if(ref($hashref->{$key}) eq 'ARRAY') {
+      $result.=&arrayref2str($hashref->{$key}).'&';
+    } elsif(ref($hashref->{$key}) eq 'HASH') {
+      $result.=&hashref2str($hashref->{$key}).'&';
+    } elsif(ref($hashref->{$key})) {
        $result.='&';
-      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
+      #print("Got a ref of ".(ref($hashref->{$key}))." skipping.");
     } else {
-      $result.=&escape($hashref->{$_}).'&';
+      $result.=&escape($hashref->{$key}).'&';
     }
   }
   $result=~s/\&$//;
@@ -2578,8 +2572,8 @@ sub store {
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
-    foreach (keys %$storehash) {
-        $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+    foreach my $key (keys(%$storehash)) {
+        $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
@@ -2614,8 +2608,8 @@ sub cstore {
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
-    foreach (keys %$storehash) {
-        $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+    foreach my $key (keys(%$storehash)) {
+        $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
     }
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
@@ -2647,14 +2641,14 @@ sub restore {
     my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
 
     my %returnhash=();
-    foreach (split(/\&/,$answer)) {
-	my ($name,$value)=split(/\=/,$_);
+    foreach my $line (split(/\&/,$answer)) {
+	my ($name,$value)=split(/\=/,$line);
         $returnhash{&unescape($name)}=&thaw_unescape($value);
     }
     my $version;
     for ($version=1;$version<=$returnhash{'version'};$version++) {
-       foreach (split(/\:/,$returnhash{$version.':keys'})) {
-          $returnhash{$_}=$returnhash{$version.':'.$_};
+       foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
+          $returnhash{$item}=$returnhash{$version.':'.$item};
        }
     }
     return %returnhash;
@@ -2729,9 +2723,9 @@ sub privileged {
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
     my $now=time;
     if ($rolesdump ne '') {
-        foreach (split(/&/,$rolesdump)) {
-	    if ($_!~/^rolesdef_/) {
-		my ($area,$role)=split(/=/,$_);
+        foreach my $entry (split(/&/,$rolesdump)) {
+	    if ($entry!~/^rolesdef_/) {
+		my ($area,$role)=split(/=/,$entry);
 		$area=~s/\_\w\w$//;
 		my ($trole,$tend,$tstart)=split(/_/,$role);
 		if (($trole eq 'dc') || ($trole eq 'su')) {
@@ -2763,9 +2757,9 @@ sub rolesinit {
     my $group_privs;
 
     if ($rolesdump ne '') {
-        foreach (split(/&/,$rolesdump)) {
-	  if ($_!~/^rolesdef_/) {
-            my ($area,$role)=split(/=/,$_);
+        foreach my $entry (split(/&/,$rolesdump)) {
+	  if ($entry!~/^rolesdef_/) {
+            my ($area,$role)=split(/=/,$entry);
 	    $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart,$group_privs);
 	    if ($role=~/^cr/) { 
@@ -2895,15 +2889,15 @@ sub set_userprivs {
             }
         }
     }
-    foreach (keys(%grouproles)) {
-        $$allroles{$_} = $grouproles{$_};
+    foreach my $group (keys(%grouproles)) {
+        $$allroles{$group} = $grouproles{$group};
     }
-    foreach (keys %{$allroles}) {
-        my %thesepriv=();
-        if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
-        foreach (split(/:/,$$allroles{$_})) {
-            if ($_ ne '') {
-                my ($privilege,$restrictions)=split(/&/,$_);
+    foreach my $role (keys(%{$allroles})) {
+        my %thesepriv;
+        if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; }
+        foreach my $item (split(/:/,$$allroles{$role})) {
+            if ($item ne '') {
+                my ($privilege,$restrictions)=split(/&/,$item);
                 if ($restrictions eq '') {
                     $thesepriv{$privilege}='F';
                 } elsif ($thesepriv{$privilege} ne 'F') {
@@ -2913,8 +2907,10 @@ sub set_userprivs {
             }
         }
         my $thesestr='';
-        foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
-        $userroles->{'user.priv.'.$_} = $thesestr;
+        foreach my $priv (keys(%thesepriv)) {
+	    $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
+	}
+        $userroles->{'user.priv.'.$role} = $thesestr;
     }
     return ($author,$adv);
 }
@@ -2924,8 +2920,8 @@ sub set_userprivs {
 sub get {
    my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
-   foreach (@$storearr) {
-       $items.=escape($_).'&';
+   foreach my $item (@$storearr) {
+       $items.=&escape($item).'&';
    }
    $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
@@ -2939,8 +2935,8 @@ sub get {
    }
    my %returnhash=();
    my $i=0;
-   foreach (@$storearr) {
-      $returnhash{$_}=&thaw_unescape($pairs[$i]);
+   foreach my $item (@$storearr) {
+      $returnhash{$item}=&thaw_unescape($pairs[$i]);
       $i++;
    }
    return %returnhash;
@@ -2951,8 +2947,8 @@ sub get {
 sub del {
    my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
-   foreach (@$storearr) {
-       $items.=escape($_).'&';
+   foreach my $item (@$storearr) {
+       $items.=&escape($item).'&';
    }
    $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
@@ -3002,8 +2998,8 @@ sub getkeys {
    my $uhome=&homeserver($uname,$udomain);
    my $rep=reply("keys:$udomain:$uname:$namespace",$uhome);
    my @keyarray=();
-   foreach (split(/\&/,$rep)) {
-      push (@keyarray,&unescape($_));
+   foreach my $key (split(/\&/,$rep)) {
+      push(@keyarray,&unescape($key));
    }
    return @keyarray;
 }
@@ -3030,8 +3026,8 @@ sub currentdump {
        %returnhash = %{&convert_dump_to_currentdump(\%hash)};
    } else {
        my @pairs=split(/\&/,$rep);
-       foreach (@pairs) {
-           my ($key,$value)=split(/=/,$_);
+       foreach my $pair (@pairs) {
+           my ($key,$value)=split(/=/,$pair,2);
            my ($symb,$param) = split(/:/,$key);
            $returnhash{&unescape($symb)}->{&unescape($param)} = 
                                                         &thaw_unescape($value);
@@ -3109,8 +3105,8 @@ sub put {
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
-   foreach (keys %$storehash) {
-       $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+   foreach my $item (keys(%$storehash)) {
+       $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
    }
    $items=~s/\&$//;
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -3162,22 +3158,22 @@ sub old_putstore {
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
     my %newstorehash;
-    foreach (keys %$storehash) {
-	my $key = $version.':'.&escape($symb).':'.$_;
-	$newstorehash{$key} = $storehash->{$_};
+    foreach my $item (keys(%$storehash)) {
+	my $key = $version.':'.&escape($symb).':'.$item;
+	$newstorehash{$key} = $storehash->{$item};
     }
     my $items='';
     my %allitems = ();
-    foreach (keys %newstorehash) {
-	if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
+    foreach my $item (keys(%newstorehash)) {
+	if ($item =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
 	    my $key = $1.':keys:'.$2;
 	    $allitems{$key} .= $3.':';
 	}
-	$items.=$_.'='.&freeze_escape($newstorehash{$_}).'&';
+	$items.=$item.'='.&freeze_escape($newstorehash{$item}).'&';
     }
-    foreach (keys %allitems) {
-	$allitems{$_} =~ s/\:$//;
-	$items.= $_.'='.$allitems{$_}.'&';
+    foreach my $item (keys(%allitems)) {
+	$allitems{$item} =~ s/\:$//;
+	$items.= $item.'='.$allitems{$item}.'&';
     }
     $items=~s/\&$//;
     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -3191,8 +3187,8 @@ sub cput {
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
-   foreach (keys %$storehash) {
-       $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+   foreach my $item (keys(%$storehash)) {
+       $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
    }
    $items=~s/\&$//;
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -3203,8 +3199,8 @@ sub cput {
 sub eget {
    my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
-   foreach (@$storearr) {
-       $items.=escape($_).'&';
+   foreach my $item (@$storearr) {
+       $items.=&escape($item).'&';
    }
    $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
@@ -3214,8 +3210,8 @@ sub eget {
    my @pairs=split(/\&/,$rep);
    my %returnhash=();
    my $i=0;
-   foreach (@$storearr) {
-      $returnhash{$_}=&thaw_unescape($pairs[$i]);
+   foreach my $item (@$storearr) {
+      $returnhash{$item}=&thaw_unescape($pairs[$i]);
       $i++;
    }
    return %returnhash;
@@ -3225,8 +3221,8 @@ sub eget {
 sub tmpput {
     my ($storehash,$server)=@_;
     my $items='';
-    foreach (keys(%$storehash)) {
-	$items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+    foreach my $item (keys(%$storehash)) {
+	$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
     }
     $items=~s/\&$//;
     return &reply("tmpput:$items",$server);
@@ -3464,6 +3460,15 @@ sub is_portfolio_url {
     return scalar(&parse_portfolio_url($url));
 }
 
+sub is_portfolio_file {
+    my ($file) = @_;
+    if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) {
+        return 1;
+    }
+    return;
+}
+
+
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {
@@ -3472,13 +3477,13 @@ sub customaccess {
     $urealm=~s/^\W//;
     my ($udom,$ucrs,$usec)=split(/\//,$urealm);
     my $access=0;
-    foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
-	my ($effect,$realm,$role)=split(/\:/,$_);
+    foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
+	my ($effect,$realm,$role)=split(/\:/,$right);
         if ($role) {
 	   if ($role ne $urole) { next; }
         }
-        foreach (split(/\s*\,\s*/,$realm)) {
-            my ($tdom,$tcrs,$tsec)=split(/\_/,$_);
+        foreach my $scope (split(/\s*\,\s*/,$realm)) {
+            my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
             if ($tdom) {
 		if ($tdom ne $udom) { next; }
             }
@@ -3690,14 +3695,14 @@ sub allowed {
        if ($checkreferer) {
 	  my $refuri=$env{'httpref.'.$orguri};
             unless ($refuri) {
-                foreach (keys %env) {
-		    if ($_=~/^httpref\..*\*/) {
-			my $pattern=$_;
+                foreach my $key (keys(%env)) {
+		    if ($key=~/^httpref\..*\*/) {
+			my $pattern=$key;
                         $pattern=~s/^httpref\.\/res\///;
                         $pattern=~s/\*/\[\^\/\]\+/g;
                         $pattern=~s/\//\\\//g;
                         if ($orguri=~/$pattern/) {
-			    $refuri=$env{$_};
+			    $refuri=$env{$key};
                         }
                     }
                 }
@@ -3915,8 +3920,8 @@ sub get_symb_from_alias {
 sub definerole {
   if (allowed('mcr','/')) {
     my ($rolename,$sysrole,$domrole,$courole)=@_;
-    foreach (split(':',$sysrole)) {
-	my ($crole,$cqual)=split(/\&/,$_);
+    foreach my $role (split(':',$sysrole)) {
+	my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
         if ($pr{'cr:s'}=~/\Q$crole\E\&/) {
 	    if ($pr{'cr:s'}!~/\Q$crole\E\&\w*\Q$cqual\E/) { 
@@ -3924,8 +3929,8 @@ sub definerole {
             }
         }
     }
-    foreach (split(':',$domrole)) {
-	my ($crole,$cqual)=split(/\&/,$_);
+    foreach my $role (split(':',$domrole)) {
+	my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:d'}!~/\Q$crole\E/) { return "refused:d:$crole"; }
         if ($pr{'cr:d'}=~/\Q$crole\E\&/) {
 	    if ($pr{'cr:d'}!~/\Q$crole\W\&\w*\Q$cqual\E/) { 
@@ -3933,8 +3938,8 @@ sub definerole {
             }
         }
     }
-    foreach (split(':',$courole)) {
-	my ($crole,$cqual)=split(/\&/,$_);
+    foreach my $role (split(':',$courole)) {
+	my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:c'}!~/\Q$crole\E/) { return "refused:c:$crole"; }
         if ($pr{'cr:c'}=~/\Q$crole\E\&/) {
 	    if ($pr{'cr:c'}!~/\Q$crole\E\&\w*\Q$cqual\E/) { 
@@ -3981,7 +3986,7 @@ sub log_query {
     my $uhome=&homeserver($uname,$udom);
     if ($uhome eq 'no_host') { return 'error: no_host'; }
     my $uhost=$hostname{$uhome};
-    my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys %filters));
+    my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys(%filters)));
     my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
                        $uhome);
     unless ($queryid=~/^\Q$uhost\E\_/) { return 'error: '.$queryid; }
@@ -4002,8 +4007,8 @@ sub fetch_enrollment_query {
     }
     my $host=$hostname{$homeserver};
     my $cmd = '';
-    foreach (keys %{$affiliatesref}) {
-        $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
+    foreach my $affiliate (keys %{$affiliatesref}) {
+        $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
     }
     $cmd =~ s/%%$//;
     $cmd = &escape($cmd);
@@ -4024,18 +4029,18 @@ sub fetch_enrollment_query {
     } else {
         my @responses = split/:/,$reply;
         if ($homeserver eq $perlvar{'lonHostID'}) {
-            foreach (@responses) {
-                my ($key,$value) = split/=/,$_;
+            foreach my $line (@responses) {
+                my ($key,$value) = split(/=/,$line,2);
                 $$replyref{$key} = $value;
             }
         } else {
             my $pathname = $perlvar{'lonDaemons'}.'/tmp';
-            foreach (@responses) {
-                my ($key,$value) = split/=/,$_;
+            foreach my $line (@responses) {
+                my ($key,$value) = split(/=/,$line);
                 $$replyref{$key} = $value;
                 if ($value > 0) {
-                    foreach (@{$$affiliatesref{$key}}) {
-                        my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';
+                    foreach my $item (@{$$affiliatesref{$key}}) {
+                        my $filename = $dom.'_'.$key.'_'.$item.'_classlist.xml';
                         my $destname = $pathname.'/'.$filename;
                         my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);
                         if ($xml_classlist =~ /^error/) {
@@ -4194,8 +4199,8 @@ sub auto_photoupdate {
     my $host=$hostname{$homeserver};
     my $cmd = '';
     my $maxtries = 1;
-    foreach (keys %{$affiliatesref}) {
-        $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
+    foreach my $affiliate (keys(%{$affiliatesref})) {
+        $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
     }
     $cmd =~ s/%%$//;
     $cmd = &escape($cmd);
@@ -4226,13 +4231,14 @@ sub auto_photoupdate {
 }
 
 sub auto_instcode_format {
-    my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
+    my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,
+	$cat_order) = @_;
     my $courses = '';
     my @homeservers;
     if ($caller eq 'global') {
-        foreach my $tryserver (keys %libserv) {
+        foreach my $tryserver (keys(%libserv)) {
             if ($hostdom{$tryserver} eq $codedom) {
-                if (!grep/^\Q$tryserver\E$/,@homeservers) {
+                if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
                     push(@homeservers,$tryserver);
                 }
             }
@@ -4240,8 +4246,8 @@ sub auto_instcode_format {
     } else {
         push(@homeservers,&homeserver($caller,$codedom));
     }
-    foreach (keys %{$instcodes}) {
-        $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';
+    foreach my $code (keys(%{$instcodes})) {
+        $courses .= &escape($code).'='.&escape($$instcodes{$code}).'&';
     }
     chop($courses);
     my $ok_response = 0;
@@ -4251,7 +4257,7 @@ sub auto_instcode_format {
         $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {
             my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = 
-                                                            split/:/,$response;
+		split/:/,$response;
             %{$codes} = (%{$codes},&str2hash($codes_str));
             push(@{$codetitles},&str2array($codetitles_str));
             %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));
@@ -4266,6 +4272,40 @@ sub auto_instcode_format {
     }
 }
 
+sub auto_instcode_defaults {
+    my ($domain,$returnhash,$code_order) = @_;
+    my @homeservers;
+    foreach my $tryserver (keys(%libserv)) {
+        if ($hostdom{$tryserver} eq $domain) {
+            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                push(@homeservers,$tryserver);
+            }
+        }
+    }
+    my $ok_response = 0;
+    my $response;
+    while (@homeservers > 0 && $ok_response == 0) {
+        my $server = shift(@homeservers);
+        $response=&reply('autoinstcodedefaults:'.$domain,$server);
+        if ($response !~ /(con_lost|error|no_such_host|refused)/) {
+            foreach my $pair (split(/\&/,$response)) {
+                my ($name,$value)=split(/\=/,$pair);
+                if ($name eq 'code_order') {
+                    @{$code_order} = split(/\&/,&unescape($value));
+                } else {
+                    $returnhash->{&unescape($name)}=&unescape($value);
+                }
+            }
+        }
+        $ok_response = 1;
+    }
+    if ($ok_response) {
+        return 'ok';
+    } else {
+        return $response;
+    }
+} 
+
 sub auto_validate_class_sec {
     my ($cdom,$cnum,$owner,$inst_class) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
@@ -4668,8 +4708,8 @@ sub modify_student_enrollment {
                        ['firstname','middlename','lastname', 'generation','id']
                        ,$udom,$uname);
 
-        #foreach (keys(%tmp)) {
-        #    &logthis("key $_ = ".$tmp{$_});
+        #foreach my $key (keys(%tmp)) {
+        #    &logthis("key $key = ".$tmp{$key});
         #}
         $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
         $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
@@ -4727,8 +4767,8 @@ sub writecoursepref {
 	return 'error: no such course';
     }
     my $cstring='';
-    foreach (keys %prefs) {
-	$cstring.=escape($_).'='.escape($prefs{$_}).'&';
+    foreach my $pref (keys(%prefs)) {
+	$cstring.=&escape($pref).'='.&escape($prefs{$pref}).'&';
     }
     $cstring=~s/\&$//;
     return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);
@@ -4935,20 +4975,20 @@ sub files_not_in_path {
     my $filename = $user."savedfiles";
     my @return_files;
     my $path_part;
-    open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
-    while (<IN>) {
+    open(IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
+    while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work
-        my @paths_and_file = split m!/!, $_;
-        my $file_part = pop (@paths_and_file);
-        chomp ($file_part);
-        my $path_part = join ('/', @paths_and_file);
+        my @paths_and_file = split(m|/|, $line);
+        my $file_part = pop(@paths_and_file);
+        chomp($file_part);
+        my $path_part = join('/', @paths_and_file);
         $path_part .= '/';
         my $path_and_file = $path_part.$file_part;
         if ($path_part ne $path) {
-            push (@return_files, ($path_and_file));
+            push(@return_files, ($path_and_file));
         }
     }
-    close (OUT);
+    close(OUT);
     return (@return_files);
 }
 
@@ -5011,8 +5051,13 @@ sub modify_access_controls {
             for (my $i=0; $i<$numnew; $i++) {
                 my $newkey = $newitems[$i];
                 my $newid = &Apache::loncommon::get_cgi_id();
-                $newkey =~ s/^(\d+)/$newid/;
-                $translation{$1} = $newid;
+                if ($newkey =~ /^\d+:/) { 
+                    $newkey =~ s/^(\d+)/$newid/;
+                    $translation{$1} = $newid;
+                } elsif ($newkey =~ /^\d+_\d+_\d+:/) {
+                    $newkey =~ s/^(\d+_\d+_\d+)/$newid/;
+                    $translation{$1} = $newid;
+                }
                 $new_values{$file_name."\0".$newkey} = 
                                           $$changes{'activate'}{$newitems[$i]};
                 $new_control{$newkey} = $now;
@@ -5212,28 +5257,27 @@ sub dirlist {
 
     if($udom) {
         if($uname) {
-            my $listing=reply('ls2:'.$dirRoot.'/'.$uri,
-                              homeserver($uname,$udom));
+            my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
+				 &homeserver($uname,$udom));
             my @listing_results;
             if ($listing eq 'unknown_cmd') {
-                $listing=reply('ls:'.$dirRoot.'/'.$uri,
-                               homeserver($uname,$udom));
+                $listing = &reply('ls:'.$dirRoot.'/'.$uri,
+				  &homeserver($uname,$udom));
                 @listing_results = split(/:/,$listing);
             } else {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);
             }
             return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {
-            my $tryserver;
-            my %allusers=();
-            foreach $tryserver (keys %libserv) {
+            my %allusers;
+            foreach my $tryserver (keys(%libserv)) {
                 if($hostdom{$tryserver} eq $udom) {
-                    my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
-                                      $udom, $tryserver);
+                    my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+					 $udom, $tryserver);
                     my @listing_results;
                     if ($listing eq 'unknown_cmd') {
-                        $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
-                                       $udom, $tryserver);
+                        $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+					  $udom, $tryserver);
                         @listing_results = split(/:/,$listing);
                     } else {
                         @listing_results =
@@ -5242,40 +5286,36 @@ sub dirlist {
                     if ($listing_results[0] ne 'no_such_dir' && 
                         $listing_results[0] ne 'empty'       &&
                         $listing_results[0] ne 'con_lost') {
-                        foreach (@listing_results) {
-                            my ($entry,@stat)=split(/&/,$_);
-                            $allusers{$entry}=1;
+                        foreach my $line (@listing_results) {
+                            my ($entry) = split(/&/,$line,2);
+                            $allusers{$entry} = 1;
                         }
                     }
                 }
             }
             my $alluserstr='';
-            foreach (sort keys %allusers) {
-                $alluserstr.=$_.'&user:';
+            foreach my $user (sort(keys(%allusers))) {
+                $alluserstr.=$user.'&user:';
             }
             $alluserstr=~s/:$//;
             return split(/:/,$alluserstr);
         } else {
-            my @emptyResults = ();
-            push(@emptyResults, 'missing user name');
-            return split(':',@emptyResults);
+            return ('missing user name');
         }
     } elsif(!defined($alternateDirectoryRoot)) {
         my $tryserver;
         my %alldom=();
-        foreach $tryserver (keys %libserv) {
+        foreach $tryserver (keys(%libserv)) {
             $alldom{$hostdom{$tryserver}}=1;
         }
         my $alldomstr='';
-        foreach (sort keys %alldom) {
-            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'/&domain:';
+        foreach my $domain (sort(keys(%alldom))) {
+            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';
         }
         $alldomstr=~s/:$//;
         return split(/:/,$alldomstr);       
     } else {
-        my @emptyResults = ();
-        push(@emptyResults, 'missing domain');
-        return split(':',@emptyResults);
+        return ('missing domain');
     }
 }
 
@@ -5312,13 +5352,8 @@ sub GetFileTimestamp {
 
 sub stat_file {
     my ($uri) = @_;
-    $uri = &clutter($uri);
+    $uri = &clutter_with_no_wrapper($uri);
 
-    # we want just the url part without the unneeded accessor url bits
-    if ($uri =~ m-^/adm/-) {
-	$uri=~s-^/adm/wrapper/-/-;
-	$uri=~s-^/adm/coursedocs/showdoc/-/-;
-    }
     my ($udom,$uname,$file,$dir);
     if ($uri =~ m-^/(uploaded|editupload)/-) {
 	($udom,$uname,$file) =
@@ -5550,8 +5585,7 @@ sub EXT {
 	$symbparm=&get_symb_from_alias($symbparm);
     }
     if (!($uname && $udom)) {
-      (my $cursymb,$courseid,$udom,$uname,$publicuser)=
-	  &Apache::lonxml::whichuser($symbparm);
+      (my $cursymb,$courseid,$udom,$uname,$publicuser)= &whichuser($symbparm);
       if (!$symbparm) {	$symbparm=$cursymb; }
     } else {
 	$courseid=$env{'request.course.id'};
@@ -6205,7 +6239,7 @@ sub gettitle {
 sub get_slot {
     my ($which,$cnum,$cdom)=@_;
     if (!$cnum || !$cdom) {
-	(undef,my $courseid)=&Apache::lonxml::whichuser();
+	(undef,my $courseid)=&whichuser();
 	$cdom=$env{'course.'.$courseid.'.domain'};
 	$cnum=$env{'course.'.$courseid.'.num'};
     }
@@ -6254,9 +6288,6 @@ sub symblist {
 sub symbverify {
     my ($symb,$thisurl)=@_;
     my $thisfn=$thisurl;
-# wrapper not part of symbs
-    $thisfn=~s/^\/adm\/wrapper//;
-    $thisfn=~s/^\/adm\/coursedocs\/showdoc\///;
     $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }
@@ -6280,13 +6311,13 @@ sub symbverify {
         }
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
-	    foreach (split(/\,/,$ids)) {
-	       my ($mapid,$resid)=split(/\./,$_);
+	    foreach my $id (split(/\,/,$ids)) {
+	       my ($mapid,$resid)=split(/\./,$id);
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
 		   if (($env{'request.role.adv'}) ||
-		       $bighash{'encrypted_'.$_} eq $env{'request.enc'}) {
+		       $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
 		       $okay=1; 
 		   }
 	       }
@@ -6429,10 +6460,10 @@ sub symbread {
                  } elsif (!$donotrecurse) {
 # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;
-                     foreach (@possibilities) {
-			 my $file=$bighash{'src_'.$_};
+                     foreach my $id (@possibilities) {
+			 my $file=$bighash{'src_'.$id};
                          if (&allowed('bre',$file)) {
-         		    my ($mapid,$resid)=split(/\./,$_);
+         		    my ($mapid,$resid)=split(/\./,$id);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {
 				$realpossible++;
                                 $syval=&encode_symb($bighash{'map_id_'.$mapid},
@@ -6539,7 +6570,7 @@ sub latest_rnd_algorithm_id {
 
 sub get_rand_alg {
     my ($courseid)=@_;
-    if (!$courseid) { $courseid=(&Apache::lonxml::whichuser())[1]; }
+    if (!$courseid) { $courseid=(&whichuser())[1]; }
     if ($courseid) {
 	return $env{"course.$courseid.rndseed"};
     }
@@ -6565,7 +6596,7 @@ sub getCODE {
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
 
-    my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser();
+    my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!$symb) {
 	unless ($symb=$wsymb) { return time; }
     }
@@ -6606,8 +6637,8 @@ sub rndseed_32bit {
 	my $domainseed=unpack("%32C*",$domain) << 7;
 	my $courseseed=unpack("%32C*",$courseid);
 	my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
-	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&logthis("rndseed :$num:$symb");
 	if ($_64bit) { $num=(($num<<32)>>32); }
 	return $num;
     }
@@ -6627,8 +6658,8 @@ sub rndseed_64bit {
 	
 	my $num1=$symbchck+$symbseed+$namechck;
 	my $num2=$nameseed+$domainseed+$courseseed;
-	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&logthis("rndseed :$num:$symb");
 	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	return "$num1,$num2";
@@ -6651,8 +6682,8 @@ sub rndseed_64bit2 {
 	
 	my $num1=$symbchck+$symbseed+$namechck;
 	my $num2=$nameseed+$domainseed+$courseseed;
-	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&logthis("rndseed :$num:$symb");
 	return "$num1,$num2";
     }
 }
@@ -6673,8 +6704,8 @@ sub rndseed_64bit3 {
 	
 	my $num1=$symbchck+$symbseed+$namechck;
 	my $num2=$nameseed+$domainseed+$courseseed;
-	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
+	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&logthis("rndseed :$num1:$num2:$_64bit");
 	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	
 	return "$num1:$num2";
@@ -6697,8 +6728,8 @@ sub rndseed_64bit4 {
 	
 	my $num1=$symbchck+$symbseed+$namechck;
 	my $num2=$nameseed+$domainseed+$courseseed;
-	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
+	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&logthis("rndseed :$num1:$num2:$_64bit");
 	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	
 	return "$num1:$num2";
@@ -6722,8 +6753,8 @@ sub rndseed_CODE_64bit {
 	my $courseseed=unpack("%32S*",$courseid.' ');
 	my $num1=$symbseed+$CODEchck;
 	my $num2=$CODEseed+$courseseed+$symbchck;
-	#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
+	#&logthis("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
+	#&logthis("rndseed :$num1:$num2:$symb");
 	if ($_64bit) { $num1=(($num1<<32)>>32); }
 	if ($_64bit) { $num2=(($num2<<32)>>32); }
 	return "$num1:$num2";
@@ -6741,8 +6772,8 @@ sub rndseed_CODE_64bit4 {
 	my $courseseed=unpack("%32S*",$courseid.' ');
 	my $num1=$symbseed+$CODEchck;
 	my $num2=$CODEseed+$courseseed+$symbchck;
-	#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
-	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
+	#&logthis("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
+	#&logthis("rndseed :$num1:$num2:$symb");
 	if ($_64bit) { $num1=(($num1<<32)>>32); }
 	if ($_64bit) { $num2=(($num2<<32)>>32); }
 	return "$num1:$num2";
@@ -6803,8 +6834,7 @@ sub ireceipt {
     my $return =&recprefix($fucourseid).'-';
     if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
 	$env{'request.state'} eq 'construct') {
-	&Apache::lonxml::debug("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname).
-			       " and ".($cpart%$cudom));
+	#&logthis("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname)." and ".($cpart%$cudom));
 			       
 	$return.= ($cunique%$cuname+
 		   $cunique%$cudom+
@@ -6827,10 +6857,48 @@ sub ireceipt {
 
 sub receipt {
     my ($part)=@_;
-    my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+    my ($symb,$courseid,$domain,$name) = &whichuser();
     return &ireceipt($name,$domain,$courseid,$symb,$part);
 }
 
+sub whichuser {
+    my ($passedsymb)=@_;
+    my ($symb,$courseid,$domain,$name,$publicuser);
+    if (defined($env{'form.grade_symb'})) {
+	my ($tmp_courseid)=&get_env_multiple('form.grade_courseid');
+	my $allowed=&allowed('vgr',$tmp_courseid);
+	if (!$allowed &&
+	    exists($env{'request.course.sec'}) &&
+	    $env{'request.course.sec'} !~ /^\s*$/) {
+	    $allowed=&allowed('vgr',$tmp_courseid.
+			      '/'.$env{'request.course.sec'});
+	}
+	if ($allowed) {
+	    ($symb)=&get_env_multiple('form.grade_symb');
+	    $courseid=$tmp_courseid;
+	    ($domain)=&get_env_multiple('form.grade_domain');
+	    ($name)=&get_env_multiple('form.grade_username');
+	    return ($symb,$courseid,$domain,$name,$publicuser);
+	}
+    }
+    if (!$passedsymb) {
+	$symb=&symbread();
+    } else {
+	$symb=$passedsymb;
+    }
+    $courseid=$env{'request.course.id'};
+    $domain=$env{'user.domain'};
+    $name=$env{'user.name'};
+    if ($name eq 'public' && $domain eq 'public') {
+	if (!defined($env{'form.username'})) {
+	    $env{'form.username'}.=time.rand(10000000);
+	}
+	$name.=$env{'form.username'};
+    }
+    return ($symb,$courseid,$domain,$name,$publicuser);
+
+}
+
 # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or 
 # -1 if the file doesn't exist
@@ -6954,7 +7022,7 @@ sub readfile {
     my $fh;
     open($fh,"<$file");
     my $a='';
-    while (<$fh>) { $a .=$_; }
+    while (my $line = <$fh>) { $a .= $line; }
     return $a;
 }
 
@@ -7093,6 +7161,15 @@ sub clutter {
     return $thisfn;
 }
 
+sub clutter_with_no_wrapper {
+    my $uri = &clutter(shift);
+    if ($uri =~ m-^/adm/-) {
+	$uri =~ s-^/adm/wrapper/-/-;
+	$uri =~ s-^/adm/coursedocs/showdoc/-/-;
+    }
+    return $uri;
+}
+
 sub freeze_escape {
     my ($value)=@_;
     if (ref($value)) {
@@ -7156,12 +7233,12 @@ BEGIN {
     %domain_auth_arg_def = ();
     my $fh;
     if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
-       while (<$fh>) {
-           next if (/^(\#|\s*$)/);
+	while (my $line = <$fh>) {
+           next if ($line =~ /^(\#|\s*$)/);
 #           next if /^\#/;
-           chomp;
+           chomp $line;
            my ($domain, $domain_description, $def_auth, $def_auth_arg,
-	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_);
+	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);
 	   $domain_auth_def{$domain}=$def_auth;
            $domain_auth_arg_def{$domain}=$def_auth_arg;
 	   $domaindescription{$domain}=$domain_description;
@@ -7491,6 +7568,13 @@ B<delenv($regexp)>: removes all items fr
 environment file that matches the regular expression in $regexp. The
 values are also delted from the current processes %env.
 
+=item * get_env_multiple($name) 
+
+gets $name from the %env hash, it seemlessly handles the cases where multiple
+values may be defined and end up as an array ref.
+
+returns an array of values
+
 =back
 
 =head2 User Information