--- loncom/lonnet/perl/lonnet.pm	2010/03/21 18:31:53	1.1057
+++ loncom/lonnet/perl/lonnet.pm	2010/05/04 15:21:29	1.1062
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1057 2010/03/21 18:31:53 www Exp $
+# $Id: lonnet.pm,v 1.1062 2010/05/04 15:21:29 droeschl Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -665,30 +665,6 @@ sub userload {
     return $userloadpercent;
 }
 
-# ------------------------------------------ Fight off request when overloaded
-
-sub overloaderror {
-    my ($r,$checkserver)=@_;
-    unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
-    my $loadavg;
-    if ($checkserver eq $perlvar{'lonHostID'}) {
-       open(my $loadfile,'/proc/loadavg');
-       $loadavg=<$loadfile>;
-       $loadavg =~ s/\s.*//g;
-       $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
-       close($loadfile);
-    } else {
-       $loadavg=&reply('load',$checkserver);
-    }
-    my $overload=$loadavg-100;
-    if ($overload>0) {
-	$r->err_headers_out->{'Retry-After'}=$overload;
-        $r->log_error('Overload of '.$overload.' on '.$checkserver);
-        return 413;
-    }    
-    return '';
-}
-
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
@@ -4539,7 +4515,7 @@ sub get_portfolio_access {
                 my (%allgroups,%allroles); 
                 my ($start,$end,$role,$sec,$group);
                 foreach my $envkey (%env) {
-                    if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
+                    if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
                         my $cid = $2.'_'.$3; 
                         if ($1 eq 'gr') {
                             $group = $4;
@@ -5476,6 +5452,8 @@ sub metadata_query {
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
+#SD remove this
+&logthis("Querying server:$server");
 	unless ($custom or $customshow) {
 	    my $reply=&reply("querysend:".&escape($query),$server);
 	    $rhash{$server}=$reply;
@@ -6439,12 +6417,18 @@ sub modifyuser {
     my ($udom,    $uname, $uid,
         $umode,   $upass, $first,
         $middle,  $last,  $gene,
-        $forceid, $desiredhome, $email, $inststatus)=@_;
+        $forceid, $desiredhome, $email, $inststatus, $candelete)=@_;
     $udom= &LONCAPA::clean_domain($udom);
     $uname=&LONCAPA::clean_username($uname);
+    my $showcandelete = 'none';
+    if (ref($candelete) eq 'ARRAY') {
+        if (@{$candelete} > 0) {
+            $showcandelete = join(', ',@{$candelete});
+        }
+    }
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.'(forceid: '.$forceid.')'.
+	     $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
              ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
@@ -6509,9 +6493,33 @@ sub modifyuser {
         %names = @tmp;
     }
 #
-# Make sure to not trash student environment if instructor does not bother
-# to supply name and email information
-#
+# If name, email and/or uid are blank (e.g., because an uploaded file
+# of users did not contain them), do not overwrite existing values
+# unless field is in $candelete array ref.  
+#
+
+    my @fields = ('firstname','middlename','lastname','generation',
+                  'permanentemail','id');
+    my %newvalues;
+    if (ref($candelete) eq 'ARRAY') {
+        foreach my $field (@fields) {
+            if (grep(/^\Q$field\E$/,@{$candelete})) {
+                if ($field eq 'firstname') {
+                    $names{$field} = $first;
+                } elsif ($field eq 'middlename') {
+                    $names{$field} = $middle;
+                } elsif ($field eq 'lastname') {
+                    $names{$field} = $last;
+                } elsif ($field eq 'generation') { 
+                    $names{$field} = $gene;
+                } elsif ($field eq 'permanentemail') {
+                    $names{$field} = $email;
+                } elsif ($field eq 'id') {
+                    $names{$field}  = $uid;
+                }
+            }
+        }
+    }
     if ($first)  { $names{'firstname'}  = $first; }
     if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
@@ -9653,6 +9661,12 @@ sub get_dns {
 	return %libserv;
     }
 
+    sub unique_library {
+	#2x reverse removes all hostnames that appear more than once
+        my %unique = reverse &all_library();
+        return reverse %unique;
+    }
+
     sub get_servers {
 	&load_hosts_tab() if (!$loaded);
 
@@ -9676,6 +9690,11 @@ sub get_dns {
 	return %result;
     }
 
+    sub get_unique_servers {
+        my %unique = reverse &get_servers(@_);
+	return reverse %unique;
+    }
+
     sub host_domain {
 	&load_hosts_tab() if (!$loaded);
 
@@ -10238,9 +10257,16 @@ modifyuserauth($udom,$uname,$umode,$upas
 
 =item *
 
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
-           $forceid,$desiredhome,$email,$inststatus) : 
-modify user
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last, $gene,
+           $forceid,$desiredhome,$email,$inststatus,$candelete) :
+
+will update user information (firstname,middlename,lastname,generation,
+permanentemail), and if forceid is true, student/employee ID also.
+A user's institutional affiliation(s) can also be updated.
+User information fields will not be overwritten with empty entries 
+unless the field is included in the $candelete array reference.
+This array is included when a single user is modified via "Manage Users",
+or when Autoupdate.pl is run by cron in a domain.
 
 =item *