--- loncom/lonnet/perl/lonnet.pm	2010/05/18 04:22:00	1.1056.4.1
+++ loncom/lonnet/perl/lonnet.pm	2010/05/20 18:11:18	1.1063
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.1 2010/05/18 04:22:00 raeburn Exp $
+# $Id: lonnet.pm,v 1.1063 2010/05/20 18:11:18 raeburn 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 {
@@ -3207,7 +3183,7 @@ sub get_domain_roles {
     return %personnel;
 }
 
-# ----------------------------------------------------------- Check out an item
+# ----------------------------------------------------------- Interval timing 
 
 sub get_first_access {
     my ($type,$argsymb)=@_;
@@ -3243,91 +3219,6 @@ sub set_first_access {
     return 'already_set';
 }
 
-sub checkout {
-    my ($symb,$tuname,$tudom,$tcrsid)=@_;
-    my $now=time;
-    my $lonhost=$perlvar{'lonHostID'};
-    my $infostr=&escape(
-                 'CHECKOUTTOKEN&'.
-                 $tuname.'&'.
-                 $tudom.'&'.
-                 $tcrsid.'&'.
-                 $symb.'&'.
-		 $now.'&'.$ENV{'REMOTE_ADDR'});
-    my $token=&reply('tmpput:'.$infostr,$lonhost);
-    if ($token=~/^error\:/) { 
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-        return ''; 
-    }
-
-    $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
-    $token=~tr/a-z/A-Z/;
-
-    my %infohash=('resource.0.outtoken' => $token,
-                  'resource.0.checkouttime' => $now,
-                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkout '.$infostr.' - '.
-                                                 $token)) ne 'ok') {
-	return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }
-    return $token;
-}
-
-# ------------------------------------------------------------ Check in an item
-
-sub checkin {
-    my $token=shift;
-    my $now=time;
-    my ($ta,$tb,$lonhost)=split(/\*/,$token);
-    $lonhost=~tr/A-Z/a-z/;
-    my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
-    $dtoken=~s/\W/\_/g;
-    my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
-                 split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
-
-    unless (($tuname) && ($tudom)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') failed');
-        return '';
-    }
-    
-    unless (&allowed('mgr',$tcrsid)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
-                 $env{'user.name'}.' - '.$env{'user.domain'});
-        return '';
-    }
-
-    my %infohash=('resource.0.intoken' => $token,
-                  'resource.0.checkintime' => $now,
-                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkin - '.$token)) ne 'ok') {
-	return '';
-    }
-
-    return ($symb,$tuname,$tudom,$tcrsid);    
-}
-
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -4102,7 +3993,7 @@ sub role_status {
                             } elsif ($$role eq 'gr') {
                                 my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
                                                     $env{'user.name'});
-                                my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
+                                my ($trole) = split('_',$rolehash{$$where.'_'.$$role},1);
                                 (undef,my $group_privs) = split(/\//,$trole);
                                 $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
@@ -5561,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;
@@ -6535,7 +6428,7 @@ sub modifyuser {
     }
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
-             $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
+	     $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
              ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
@@ -6599,6 +6492,7 @@ sub modifyuser {
     } else {
         %names = @tmp;
     }
+#
 # 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.  
@@ -9767,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);
 
@@ -9790,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);