--- loncom/lonnet/perl/lonnet.pm	2002/09/16 19:42:10	1.282
+++ loncom/lonnet/perl/lonnet.pm	2002/10/07 13:50:36	1.292
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.282 2002/09/16 19:42:10 albertel Exp $
+# $Id: lonnet.pm,v 1.292 2002/10/07 13:50:36 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -348,12 +348,36 @@ sub delenv {
     return 'ok';
 }
 
+# ------------------------------------------ Fight off request when overloaded
+
+sub overloaderror {
+    my ($r,$checkserver)=@_;
+    unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
+    my $loadavg;
+    if ($checkserver eq $perlvar{'lonHostID'}) {
+       my $loadfile=Apache::File->new('/proc/loadavg');
+       $loadavg=<$loadfile>;
+       $loadavg =~ s/\s.*//g;
+       $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
+    } 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 {
+    my $loadpercent = shift;
     my $tryserver;
     my $spareserver='';
-    my $lowestserver=100;
+    my $lowestserver=$loadpercent; 
     foreach $tryserver (keys %spareid) {
        my $answer=reply('load',$tryserver);
        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
@@ -620,6 +644,30 @@ sub chatsend {
 		   &escape($newentry)),$chome);
 }
 
+# ------------------------------------------ Find current version of a resource
+
+sub getversion {
+    my $fname=&clutter(shift);
+    unless ($fname=~/^\/res\//) { return -1; }
+    return &currentversion(&filelocation('',$fname));
+}
+
+sub currentversion {
+    my $fname=shift;
+    my $author=$fname;
+    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+    my ($udom,$uname)=split(/\//,$author);
+    my $home=homeserver($uname,$udom);
+    if ($home eq 'no_host') { 
+        return -1; 
+    }
+    my $answer=reply("currentversion:$fname",$home);
+    if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
+	return -1;
+    }
+    return $answer;
+}
+
 # ----------------------------- Subscribe to a resource, return URL if possible
 
 sub subscribe {
@@ -628,7 +676,7 @@ sub subscribe {
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);
     my $home=homeserver($uname,$udom);
-    if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
+    if ($home eq 'no_host') { 
         return 'not_found'; 
     }
     my $answer=reply("sub:$fname",$home);
@@ -659,6 +707,11 @@ sub repcopy {
     } elsif ($remoteurl eq 'directory') {
            return OK;
     } else {
+        my $author=$filename;
+        $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+        my ($udom,$uname)=split(/\//,$author);
+        my $home=homeserver($uname,$udom);
+        unless ($home eq $perlvar{'lonHostID'}) {
            my @parts=split(/\//,$filename);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {
@@ -694,6 +747,7 @@ sub repcopy {
                rename($transname,$filename);
                return OK;
            }
+       }
     }
 }
 
@@ -1962,14 +2016,15 @@ sub is_on_map {
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
-    $pathname=~s/\/$filename$//;
+    $pathname=~s|/\Q$filename\E$||;
+    #Trying to find the conditional for the file
     my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
-	       /\&$filename\:([\d\|]+)\&/);
+	       /\&\Q$filename\E\:([\d\|]+)\&/);
     if ($match) {
-       return (1,$1);
-   } else {
-       return (0,0);
-   }
+	return (1,$1);
+    } else {
+	return (0,0);
+    }
 }
 
 # ----------------------------------------------------------------- Define Role
@@ -2564,11 +2619,11 @@ sub courseresdata {
 	}
     }
     foreach my $item (@which) {
-	if ($courseresdatacache{$hashid}->{$item}) {
+	if (defined($courseresdatacache{$hashid}->{$item})) {
 	    return $courseresdatacache{$hashid}->{$item};
 	}
     }
-    return '';
+    return undef;
 }
 
 # --------------------------------------------------------- Value of a Variable
@@ -2715,7 +2770,7 @@ sub EXT {
 					  ($seclevelr,$seclevelm,$seclevel,
 					   $courselevelr,$courselevelm,
 					   $courselevel));
-	    if ($coursereply) { return $coursereply; }
+	    if (defined($coursereply)) { return $coursereply; }
 
 # ------------------------------------------------------ third, check map parms
 	    my %parmhash=();
@@ -2739,9 +2794,9 @@ sub EXT {
 	    $filename=$ENV{'request.filename'};
 	}
 	my $metadata=&metadata($filename,$spacequalifierrest);
-	if ($metadata) { return $metadata; }
+	if (defined($metadata)) { return $metadata; }
 	$metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
-	if ($metadata) { return $metadata; }
+	if (defined($metadata)) { return $metadata; }
 
 # ------------------------------------------------------------------ Cascade up
 	unless ($space eq '0') {
@@ -2749,11 +2804,11 @@ sub EXT {
 	    if ($id) {
 		my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
 				     $symbparm,$udom,$uname);
-		if ($partgeneral) { return $partgeneral; }
+		if (defined($partgeneral)) { return $partgeneral; }
 	    } else {
 		my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
 					 $symbparm,$udom,$uname);
-		if ($resourcegeneral) { return $resourcegeneral; }
+		if (defined($resourcegeneral)) { return $resourcegeneral; }
 	    }
 	}
 
@@ -2782,6 +2837,11 @@ sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
 
     $uri=&declutter($uri);
+    # if it is a non metadata possible uri return quickly
+    if (($uri eq '') || ($uri =~ m|^/*adm/|) || ($uri =~ m|/$|) ||
+	($uri =~ m|/.meta$|)) {
+	return '';
+    }
     my $filename=$uri;
     $uri=~s/\.meta$//;
 #
@@ -3307,7 +3367,7 @@ BEGIN {
 
     while (my $configline=<$config>) {
        chomp($configline);
-       if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
+       if ($configline) {
           $spareid{$configline}=1;
        }
     }
@@ -3571,7 +3631,48 @@ modify user
 
 =item *
 
-modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student
+modifystudent
+
+modify a students enrollment and identification information.
+The course id is resolved based on the current users environment.  
+This means the envoking user must be a course coordinator or otherwise
+associated with a course.
+
+This call is essentially a wrapper for lonnet::modifyuser
+
+Inputs: 
+
+=over 4
+
+=item B<$udom> Students loncapa domain
+
+=item B<$uname> Students loncapa login name
+
+=item B<$uid> Students id/student number
+
+=item B<$umode> Students authentication mode
+
+=item B<$upass> Students password
+
+=item B<$first> Students first name
+
+=item B<$middle> Students middle name
+
+=item B<$last> Students last name
+
+=item B<$gene> Students generation
+
+=item B<$usec> Students section in course
+
+=item B<$end> Unix time of the roles expiration
+
+=item B<$start> Unix time of the roles start date
+
+=item B<$forceid> If defined, allow $uid to be changed
+
+=item B<$desiredhome> server to use as home server for student
+
+=back
 
 =item *