version 1.273, 2002/08/23 21:31:09
|
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 2458 sub dirlist {
|
Line 2482 sub dirlist {
|
} |
} |
} |
} |
|
|
|
# --------------------------------------------- GetFileTimestamp |
|
# This function utilizes dirlist and returns the date stamp for |
|
# when it was last modified. It will also return an error of -1 |
|
# if an error occurs |
|
|
|
sub GetFileTimestamp { |
|
my ($studentDomain,$studentName,$filename,$root)=@_; |
|
$studentDomain=~s/\W//g; |
|
$studentName=~s/\W//g; |
|
my $subdir=$studentName.'__'; |
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
|
my $proname="$studentDomain/$subdir/$studentName"; |
|
$proname .= '/'.$filename; |
|
my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName, |
|
$root); |
|
my $fileStat = $dir[0]; |
|
my @stats = split('&', $fileStat); |
|
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { |
|
return $stats[9]; |
|
} else { |
|
return -1; |
|
} |
|
} |
|
|
# -------------------------------------------------------- Value of a Condition |
# -------------------------------------------------------- Value of a Condition |
|
|
sub directcondval { |
sub directcondval { |
Line 2510 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 2541 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 2698 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 2750 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 2773 sub metadata {
|
Line 2835 sub metadata {
|
my $package=$token->[2]->{'package'}; |
my $package=$token->[2]->{'package'}; |
my $keyroot=''; |
my $keyroot=''; |
if ($prefix) { |
if ($prefix) { |
$keyroot.='_'.$prefix; |
$keyroot.=$prefix; |
} else { |
} else { |
if (defined($token->[2]->{'part'})) { |
if (defined($token->[2]->{'part'})) { |
$keyroot.='_'.$token->[2]->{'part'}; |
$keyroot.='_'.$token->[2]->{'part'}; |
Line 2831 sub metadata {
|
Line 2893 sub metadata {
|
# |
# |
# Importing a library here |
# Importing a library here |
# |
# |
if (defined($depthcount)) { $depthcount++; } else |
|
{ $depthcount=0; } |
|
if ($depthcount<20) { |
if ($depthcount<20) { |
foreach (split(/\,/,&metadata($uri,'keys', |
my $location=$parser->get_text('/import'); |
$parser->get_text('/import'),$unikey, |
my $dir=$filename; |
$depthcount))) { |
$dir=~s|[^/]*$||; |
|
$location=&filelocation($dir,$location); |
|
foreach (sort(split(/\,/,&metadata($uri,'keys', |
|
$location,$unikey, |
|
$depthcount+1)))) { |
$metathesekeys{$_}=1; |
$metathesekeys{$_}=1; |
} |
} |
} |
} |
Line 2861 sub metadata {
|
Line 2925 sub metadata {
|
# the next is the end of "start tag" |
# the next is the end of "start tag" |
} |
} |
} |
} |
&metadata_generate_part0(\%metathesekeys,\%metacache,$uri); |
|
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
|
&metadata_generate_part0(\%metathesekeys,\%metacache,$uri); |
|
$metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':cachedtimestamp'}=time; |
$metacache{$uri.':cachedtimestamp'}=time; |
# this is the end of "was not already recently cached |
# this is the end of "was not already recently cached |
} |
} |
Line 2934 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 3005 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 3265 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 3313 BEGIN {
|
Line 3378 BEGIN {
|
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |