--- loncom/lonnet/perl/lonnet.pm 2002/08/13 14:37:52 1.267 +++ loncom/lonnet/perl/lonnet.pm 2002/09/16 20:30:26 1.267.4.6 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.267 2002/08/13 14:37:52 albertel Exp $ +# $Id: lonnet.pm,v 1.267.4.6 2002/09/16 20:30:26 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2137,7 +2137,8 @@ sub modifyuserauth { my $uhome=&homeserver($uname,$udom); unless (&allowed('mau',$udom)) { return 'refused'; } &logthis('Call to modify user authentication '.$udom.', '.$uname.', '. - $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}); + $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' in domain '.$ENV{'request.role.domain'}); my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'. &escape($upass),$uhome); &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'}, @@ -2168,7 +2169,8 @@ sub modifyuser { $last.', '.$gene.'(forceid: '.$forceid.')'. (defined($desiredhome) ? ' desiredhome = '.$desiredhome : ' desiredhome not specified'). - ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}); + ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' in domain '.$ENV{'request.role.domain'}); my $uhome=&homeserver($uname,$udom,'true'); # ----------------------------------------------------------------- Create User if (($uhome eq 'no_host') && ($umode) && ($upass)) { @@ -2428,6 +2430,30 @@ 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 sub directcondval { @@ -2511,7 +2537,7 @@ sub courseresdata { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm,$udom,$uname)=@_; + my ($varname,$symbparm,$udom,$uname,)=@_; unless ($varname) { return ''; } @@ -2668,10 +2694,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 @@ -2720,7 +2752,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? # @@ -2743,7 +2775,7 @@ sub metadata { my $package=$token->[2]->{'package'}; my $keyroot=''; if ($prefix) { - $keyroot.='_'.$prefix; + $keyroot.=$prefix; } else { if (defined($token->[2]->{'part'})) { $keyroot.='_'.$token->[2]->{'part'}; @@ -2801,12 +2833,14 @@ sub metadata { # # Importing a library here # - if (defined($depthcount)) { $depthcount++; } else - { $depthcount=0; } if ($depthcount<20) { - foreach (split(/\,/,&metadata($uri,'keys', - $parser->get_text('/import'),$unikey, - $depthcount))) { + my $location=$parser->get_text('/import'); + my $dir=$filename; + $dir=~s|[^/]*$||; + $location=&filelocation($dir,$location); + foreach (sort(split(/\,/,&metadata($uri,'keys', + $location,$unikey, + $depthcount+1)))) { $metathesekeys{$_}=1; } } @@ -2831,8 +2865,9 @@ sub metadata { # the next is the end of "start tag" } } - &metadata_generate_part0(\%metathesekeys,\%metacache,$uri); $metacache{$uri.':keys'}=join(',',keys %metathesekeys); + &metadata_generate_part0(\%metathesekeys,\%metacache,$uri); + $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys); $metacache{$uri.':cachedtimestamp'}=time; # this is the end of "was not already recently cached }