version 1.276, 2002/08/30 18:36:03
|
version 1.286, 2002/09/24 18:25:45
|
Line 348 sub delenv {
|
Line 348 sub delenv {
|
return 'ok'; |
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 |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
|
my $loadpercent = shift; |
my $tryserver; |
my $tryserver; |
my $spareserver=''; |
my $spareserver=''; |
my $lowestserver=100; |
my $lowestserver=$loadpercent; |
foreach $tryserver (keys %spareid) { |
foreach $tryserver (keys %spareid) { |
my $answer=reply('load',$tryserver); |
my $answer=reply('load',$tryserver); |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
Line 871 sub countacc {
|
Line 895 sub countacc {
|
my $url=&declutter(shift); |
my $url=&declutter(shift); |
unless ($ENV{'request.course.id'}) { return ''; } |
unless ($ENV{'request.course.id'}) { return ''; } |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
if (defined($accesshash{$key})) { |
if (defined($accesshash{$key})) { |
$accesshash{$key}++; |
$accesshash{$key}++; |
} else { |
} else { |
Line 2341 sub createcourse {
|
Line 2365 sub createcourse {
|
unless ($nonstandard) { |
unless ($nonstandard) { |
# ------------------------------------------ For standard courses, make top url |
# ------------------------------------------ For standard courses, make top url |
my $mapurl=&clutter($url); |
my $mapurl=&clutter($url); |
|
if ($mapurl eq '/res/') { $mapurl=''; } |
$ENV{'form.initmap'}=(<<ENDINITMAP); |
$ENV{'form.initmap'}=(<<ENDINITMAP); |
<map> |
<map> |
<resource id="1" type="start"></resource> |
<resource id="1" type="start"></resource> |
Line 2534 sub condval {
|
Line 2559 sub condval {
|
return $result; |
return $result; |
} |
} |
|
|
|
# ---------------------------------------------------- Devalidate courseresdata |
|
|
|
sub devalidatecourseresdata { |
|
my ($coursenum,$coursedomain)=@_; |
|
my $hashid=$coursenum.':'.$coursedomain; |
|
delete $courseresdatacache{$hashid.'.time'}; |
|
} |
|
|
# --------------------------------------------------- Course Resourcedata Query |
# --------------------------------------------------- Course Resourcedata Query |
|
|
sub courseresdata { |
sub courseresdata { |
Line 2565 sub courseresdata {
|
Line 2598 sub courseresdata {
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
|
|
sub EXT { |
sub EXT { |
my ($varname,$symbparm,$udom,$uname)=@_; |
my ($varname,$symbparm,$udom,$uname,)=@_; |
|
|
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
|
|
Line 2722 sub EXT {
|
Line 2755 sub EXT {
|
# --------------------------------------------- last, look in resource metadata |
# --------------------------------------------- last, look in resource metadata |
|
|
$spacequalifierrest=~s/\./\_/; |
$spacequalifierrest=~s/\./\_/; |
my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); |
my $filename; |
|
if (!$symbparm) { $symbparm=&symbread(); } |
|
if ($symbparm) { |
|
$filename=(split(/\_\_\_/,$symbparm))[2]; |
|
} else { |
|
$filename=$ENV{'request.filename'}; |
|
} |
|
my $metadata=&metadata($filename,$spacequalifierrest); |
if ($metadata) { return $metadata; } |
if ($metadata) { return $metadata; } |
$metadata=&metadata($ENV{'request.filename'}, |
$metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
'parameter_'.$spacequalifierrest); |
|
if ($metadata) { return $metadata; } |
if ($metadata) { return $metadata; } |
|
|
# ------------------------------------------------------------------ Cascade up |
# ------------------------------------------------------------------ Cascade up |
Line 2774 sub metadata {
|
Line 2813 sub metadata {
|
# Look at timestamp of caching |
# Look at timestamp of caching |
# Everything is cached by the main uri, libraries are never directly cached |
# Everything is cached by the main uri, libraries are never directly cached |
# |
# |
unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) { |
unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600 && !defined($liburi)) { |
# |
# |
# Is this a recursive call for a library? |
# Is this a recursive call for a library? |
# |
# |
Line 2961 sub symbverify {
|
Line 3000 sub symbverify {
|
my $okay=0; |
my $okay=0; |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
my $ids=$bighash{'ids_/res/'.$thisfn}; |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
unless ($ids) { |
unless ($ids) { |
$ids=$bighash{'ids_/'.$thisfn}; |
$ids=$bighash{'ids_/'.$thisfn}; |
} |
} |
Line 3032 sub symbread {
|
Line 3071 sub symbread {
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
# ---------------------------------------------- Get ID(s) for current resource |
# ---------------------------------------------- Get ID(s) for current resource |
my $ids=$bighash{'ids_/res/'.$thisfn}; |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
unless ($ids) { |
unless ($ids) { |
$ids=$bighash{'ids_/'.$thisfn}; |
$ids=$bighash{'ids_/'.$thisfn}; |
} |
} |
Line 3292 BEGIN {
|
Line 3331 BEGIN {
|
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
if (($configline) && ($configline ne $perlvar{'lonHostID'})) { |
if ($configline) { |
$spareid{$configline}=1; |
$spareid{$configline}=1; |
} |
} |
} |
} |
Line 3340 BEGIN {
|
Line 3379 BEGIN {
|
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |
Line 3556 modify user
|
Line 3595 modify user
|
|
|
=item * |
=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 * |
=item * |
|
|