--- loncom/lonnet/perl/lonnet.pm 2003/06/10 15:52:51 1.377 +++ loncom/lonnet/perl/lonnet.pm 2003/07/03 19:26:21 1.386 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.377 2003/06/10 15:52:51 matthew Exp $ +# $Id: lonnet.pm,v 1.386 2003/07/03 19:26:21 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -982,9 +982,9 @@ sub repcopy { # ------------------------------------------------ Get server side include body sub ssi_body { - my $filelink=shift; + my ($filelink,%form)=@_; my $output=($filelink=~/^http\:/?&externalssi($filelink): - &ssi($filelink)); + &ssi($filelink,%form)); $output=~s/^.*\]*\>//si; $output=~s/\<\/body\s*\>.*$//si; $output=~ @@ -1643,7 +1643,7 @@ sub tmpreset { my ($symb,$namespace,$domain,$stuname) = @_; if (!$symb) { $symb=&symbread(); - if (!$symb) { $symb= $ENV{'REQUEST_URI'}; } + if (!$symb) { $symb= $ENV{'request.url'}; } } $symb=escape($symb); @@ -2774,7 +2774,7 @@ sub modifyuser { } $uhome=&homeserver($uname,$udom,'true'); if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) { - return 'error: verify home'; + return 'error: unable verify users home machine.'; } } # End of creation of new user # ---------------------------------------------------------------------- Add ID @@ -2784,7 +2784,8 @@ sub modifyuser { if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/) && (!$forceid)) { unless ($uid eq $uidhash{$uname}) { - return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid; + return 'error: user id "'.$uid.'" does not match '. + 'current user id "'.$uidhash{$uname}.'".'; } } else { &idput($udom,($uname => $uid)); @@ -2800,10 +2801,10 @@ sub modifyuser { } else { %names = @tmp; } - if ($first) { $names{'firstname'} = $first; } - if ($middle) { $names{'middlename'} = $middle; } - if ($last) { $names{'lastname'} = $last; } - if ($gene) { $names{'generation'} = $gene; } + if (defined($first)) { $names{'firstname'} = $first; } + if (defined($middle)) { $names{'middlename'} = $middle; } + if (defined($last)) { $names{'lastname'} = $last; } + if (defined($gene)) { $names{'generation'} = $gene; } my $reply = &put('environment', \%names, $udom,$uname); if ($reply ne 'ok') { return 'error: '.$reply; } &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. @@ -3185,8 +3186,32 @@ sub courseresdata { return undef; } -# --------------------------------------------------------- Value of a Variable +# +# EXT resource caching routines +# + +sub clear_EXT_cache_status { + &delenv('cache.EXT.'); +} + +sub EXT_cache_status { + my ($target_domain,$target_user) = @_; + my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; + if (exists($ENV{$cachename}) && ($ENV{$cachename}+1800) > time) { + # We know already the user has no data + return 1; + } else { + return 0; + } +} + +sub EXT_cache_set { + my ($target_domain,$target_user) = @_; + my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain; + &appenv($cachename => time); +} +# --------------------------------------------------------- Value of a Variable sub EXT { my ($varname,$symbparm,$udom,$uname,$usection)=@_; @@ -3196,7 +3221,7 @@ sub EXT { my $publicuser; if (!($uname && $udom)) { (my $cursymb,$courseid,$udom,$uname,$publicuser)= - &Apache::lonxml::whichuser(); + &Apache::lonxml::whichuser($symbparm); if (!$symbparm) { $symbparm=$cursymb; } } else { $courseid=$ENV{'request.course.id'}; @@ -3273,7 +3298,8 @@ sub EXT { } } elsif ($realm eq 'query') { # ---------------------------------------------- pull stuff out of query string - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + [$spacequalifierrest]); return $ENV{'form.'.$spacequalifierrest}; } elsif ($realm eq 'request') { # ------------------------------------------------------------- request.browser @@ -3321,11 +3347,9 @@ sub EXT { my $courselevelm=$courseid.'.'.$mapparm; # ----------------------------------------------------------- first, check user - #most student don't have any data set, check if there is some data + #most student don\'t have any data set, check if there is some data #every thirty minutes - if (! - (exists($ENV{'cache.studentresdata'}) - && (($ENV{'cache.studentresdata'}+1800) > time))) { + if (! &EXT_cache_status($udom,$uname)) { my %resourcedata=&get('resourcedata', [$courselevelr,$courselevelm,$courselevel], $udom,$uname); @@ -3344,9 +3368,7 @@ sub EXT { $uname." at ".$udom.": ". $tmp.""); } elsif ($tmp=~/error:No such file/) { - $ENV{'cache.studentresdata'}=time; - &appenv(('cache.studentresdata'=> - $ENV{'cache.studentresdata'})); + &EXT_cache_set($udom,$uname); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; } @@ -3632,7 +3654,13 @@ sub gettitle { unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; } return &metadata($urlsymb,'title'); } - if ($titlecache{$symb}) { return $titlecache{$symb}; } + if ($titlecache{$symb}) { + if (time < ($titlecache{$symb}[1] + 600)) { + return $titlecache{$symb}[0]; + } else { + delete($titlecache{$symb}); + } + } my ($map,$resid,$url)=split(/\_\_\_/,$symb); my $title=''; my %bighash; @@ -3644,7 +3672,7 @@ sub gettitle { } $title=~s/\&colon\;/\:/gs; if ($title) { - $titlecache{$symb}=$title; + $titlecache{$symb}=[$title,time]; return $title; } else { return &metadata($urlsymb,'title');