version 1.276, 2002/08/30 18:36:03
|
version 1.284, 2002/09/17 19:45:11
|
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; |
|
} else { |
|
$loadavg=&reply('load',$checkserver); |
|
} |
|
my $overload=$loadavg-$perlvar{'lonLoadLim'}; |
|
if ($overload>0) { |
|
$r->err_headers_out->{'Retry-After'}=$overload*30; |
|
$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 894 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 2364 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 2558 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 2597 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 2754 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 2812 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 2999 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 3070 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 3330 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 3378 BEGIN {
|
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |