--- loncom/lonnet/perl/lonnet.pm 2002/08/30 18:36:03 1.276 +++ loncom/lonnet/perl/lonnet.pm 2002/09/16 19:42:10 1.282 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.276 2002/08/30 18:36:03 albertel Exp $ +# $Id: lonnet.pm,v 1.282 2002/09/16 19:42:10 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -871,7 +871,7 @@ sub countacc { my $url=&declutter(shift); unless ($ENV{'request.course.id'}) { return ''; } $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; - my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; + my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; if (defined($accesshash{$key})) { $accesshash{$key}++; } else { @@ -2341,6 +2341,7 @@ sub createcourse { unless ($nonstandard) { # ------------------------------------------ For standard courses, make top url my $mapurl=&clutter($url); + if ($mapurl eq '/res/') { $mapurl=''; } $ENV{'form.initmap'}=(< @@ -2534,6 +2535,14 @@ sub condval { return $result; } +# ---------------------------------------------------- Devalidate courseresdata + +sub devalidatecourseresdata { + my ($coursenum,$coursedomain)=@_; + my $hashid=$coursenum.':'.$coursedomain; + delete $courseresdatacache{$hashid.'.time'}; +} + # --------------------------------------------------- Course Resourcedata Query sub courseresdata { @@ -2565,7 +2574,7 @@ sub courseresdata { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm,$udom,$uname)=@_; + my ($varname,$symbparm,$udom,$uname,)=@_; unless ($varname) { return ''; } @@ -2722,10 +2731,16 @@ sub EXT { # --------------------------------------------- last, look in resource metadata $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; } - $metadata=&metadata($ENV{'request.filename'}, - 'parameter_'.$spacequalifierrest); + $metadata=&metadata($filename,'parameter_'.$spacequalifierrest); if ($metadata) { return $metadata; } # ------------------------------------------------------------------ Cascade up @@ -2774,7 +2789,7 @@ sub metadata { # Look at timestamp of caching # 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? # @@ -2961,7 +2976,7 @@ sub symbverify { my $okay=0; if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { - my $ids=$bighash{'ids_/res/'.$thisfn}; + my $ids=$bighash{'ids_'.&clutter($thisfn)}; unless ($ids) { $ids=$bighash{'ids_/'.$thisfn}; } @@ -3032,7 +3047,7 @@ sub symbread { if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { # ---------------------------------------------- Get ID(s) for current resource - my $ids=$bighash{'ids_/res/'.$thisfn}; + my $ids=$bighash{'ids_'.&clutter($thisfn)}; unless ($ids) { $ids=$bighash{'ids_/'.$thisfn}; } @@ -3340,7 +3355,7 @@ BEGIN { %metacache=(); -$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; +$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; $dumpcount=0; &logtouch();