--- loncom/lonnet/perl/lonnet.pm 2002/09/16 19:42:10 1.282 +++ loncom/lonnet/perl/lonnet.pm 2002/10/01 07:59:33 1.288 @@ -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.288 2002/10/01 07:59:33 albertel 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)) { @@ -2564,7 +2588,7 @@ sub courseresdata { } } foreach my $item (@which) { - if ($courseresdatacache{$hashid}->{$item}) { + if (defined($courseresdatacache{$hashid}->{$item})) { return $courseresdatacache{$hashid}->{$item}; } } @@ -2715,7 +2739,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 +2763,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 +2773,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 +2806,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 +3336,7 @@ BEGIN { while (my $configline=<$config>) { chomp($configline); - if (($configline) && ($configline ne $perlvar{'lonHostID'})) { + if ($configline) { $spareid{$configline}=1; } } @@ -3571,7 +3600,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 *