--- loncom/lonnet/perl/lonnet.pm 2003/09/09 18:46:28 1.409
+++ loncom/lonnet/perl/lonnet.pm 2003/09/22 19:32:49 1.421
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.409 2003/09/09 18:46:28 www Exp $
+# $Id: lonnet.pm,v 1.421 2003/09/22 19:32:49 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -76,7 +76,7 @@ qw(%perlvar %hostname %homecache %badSer
%libserv %pr %prp %metacache %packagetab %titlecache
%courselogs %accesshash %userrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache
- %domaindescription %domain_auth_def %domain_auth_arg_def
+ %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);
use IO::Socket;
@@ -85,6 +85,7 @@ use Apache::Constants qw(:common :http);
use HTML::LCParser;
use Fcntl qw(:flock);
use Apache::loncoursedata;
+use Apache::lonlocal;
my $readit;
@@ -246,9 +247,13 @@ sub critical {
return $answer;
}
+#
# -------------- Remove all key from the env that start witha lowercase letter
-# (Which is alweways a lon-capa value)
+# (Which is always a lon-capa value)
+
sub cleanenv {
+# unless (defined(&Apache::exists_config_define("MODPERL2"))) { return; }
+# unless (&Apache::exists_config_define("MODPERL2")) { return; }
foreach my $key (keys(%ENV)) {
if ($key =~ /^[a-z]/) {
delete($ENV{$key});
@@ -436,15 +441,27 @@ sub spareserver {
my $lowestserver=$loadpercent > $userloadpercent?
$loadpercent : $userloadpercent;
foreach $tryserver (keys %spareid) {
- my $loadans=reply('load',$tryserver);
- my $userloadans=reply('userload',$tryserver);
- if ($userloadans !~ /\d/) { $userloadans=0; }
- my $answer=$loadans > $userloadans?
- $loadans : $userloadans;
- if (($answer =~ /\d/) && ($answer<$lowestserver)) {
- $spareserver="http://$hostname{$tryserver}";
- $lowestserver=$answer;
- }
+ my $loadans=reply('load',$tryserver);
+ my $userloadans=reply('userload',$tryserver);
+ if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
+ next; #didn't get a number from the server
+ }
+ my $answer;
+ if ($loadans =~ /\d/) {
+ if ($userloadans =~ /\d/) {
+ #both are numbers, pick the bigger one
+ $answer=$loadans > $userloadans?
+ $loadans : $userloadans;
+ } else {
+ $answer = $loadans;
+ }
+ } else {
+ $answer = $userloadans;
+ }
+ if (($answer =~ /\d/) && ($answer<$lowestserver)) {
+ $spareserver="http://$hostname{$tryserver}";
+ $lowestserver=$answer;
+ }
}
return $spareserver;
}
@@ -831,8 +848,39 @@ sub getsection {
return '-1';
}
+sub devalidate_cache {
+ my ($cache,$id) = @_;
+ delete $$cache{$id.'.time'};
+ delete $$cache{$id};
+}
+
+sub is_cached {
+ my ($cache,$id,$time) = @_;
+ if (!$time) { $time=300; }
+ if (!exists($$cache{$id.'.time'})) {
+ return (undef,undef);
+ } else {
+ if (time-$$cache{$id.'.time'}>$time) {
+ &devalidate_cache($cache,$id);
+ return (undef,undef);
+ }
+ }
+ return ($$cache{$id},1);
+}
+
+sub do_cache {
+ my ($cache,$id,$value) = @_;
+ $$cache{$id.'.time'}=time;
+ # do_cache implictly return the set value
+ $$cache{$id}=$value;
+}
+
sub usection {
my ($udom,$unam,$courseid)=@_;
+ my $hashid="$udom:$unam:$courseid";
+
+ my ($result,$cached)=&is_cached(\%usectioncache,$hashid);
+ if (defined($cached)) { return $result; }
$courseid=~s/\_/\//g;
$courseid=~s/^(\w)/\/$1/;
foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
@@ -851,10 +899,12 @@ sub usection {
if ($end) {
if ($now>$end) { $notactive=1; }
}
- unless ($notactive) { return $section; }
+ unless ($notactive) {
+ return &do_cache(\%usectioncache,$hashid,$section);
+ }
}
}
- return '-1';
+ return &do_cache(\%usectioncache,$hashid,'-1');
}
# ------------------------------------- Read an entry from a user's environment
@@ -2590,7 +2640,10 @@ sub is_on_map {
if ($match) {
return (1,$1);
} else {
- return (0,0);
+ my ($name,$ext)=($filename=~/^(.+)\.(\w+)$/);
+ $ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+ /\&(\Q$name\E\.\d+\.$ext)\:([\d\|]+)\&/;
+ return (0,$2,$pathname.'/'.$1);
}
}
@@ -2720,7 +2773,7 @@ sub userlog_query {
sub plaintext {
my $short=shift;
- return $prp{$short};
+ return &mt($prp{$short});
}
# ----------------------------------------------------------------- Assign Role
@@ -3165,6 +3218,13 @@ sub dirlist {
# when it was last modified. It will also return an error of -1
# if an error occurs
+##
+## FIXME: This subroutine assumes its caller knows something about the
+## directory structure of the home server for the student ($root).
+## Not a good assumption to make. Since this is for looking up files
+## in user directories, the full path should be constructed by lond, not
+## whatever machine we request data from.
+##
sub GetFileTimestamp {
my ($studentDomain,$studentName,$filename,$root)=@_;
$studentDomain=~s/\W//g;
@@ -3241,7 +3301,7 @@ sub condval {
sub devalidatecourseresdata {
my ($coursenum,$coursedomain)=@_;
my $hashid=$coursenum.':'.$coursedomain;
- delete $courseresdatacache{$hashid.'.time'};
+ &devalidate_cache(\%courseresdatacache,$hashid);
}
# --------------------------------------------------- Course Resourcedata Query
@@ -3250,25 +3310,23 @@ sub courseresdata {
my ($coursenum,$coursedomain,@which)=@_;
my $coursehom=&homeserver($coursenum,$coursedomain);
my $hashid=$coursenum.':'.$coursedomain;
- my $dodump=0;
- if (!defined($courseresdatacache{$hashid.'.time'})) {
- $dodump=1;
- } else {
- if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; }
- }
- if ($dodump) {
+ my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid);
+ unless (defined($cached)) {
my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
+ $result=\%dumpreply;
my ($tmp) = keys(%dumpreply);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $courseresdatacache{$hashid.'.time'}=time;
- $courseresdatacache{$hashid}=\%dumpreply;
+ &do_cache(\%courseresdatacache,$hashid,$result);
} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
return $tmp;
+ } elsif ($tmp =~ /^(error)/) {
+ $result=undef;
+ &do_cache(\%courseresdatacache,$hashid,$result);
}
}
foreach my $item (@which) {
- if (defined($courseresdatacache{$hashid}->{$item})) {
- return $courseresdatacache{$hashid}->{$item};
+ if (defined($result->{$item})) {
+ return $result->{$item};
}
}
return undef;
@@ -3436,28 +3494,35 @@ sub EXT {
# ----------------------------------------------------------- first, check user
#most student don\'t have any data set, check if there is some data
- #every thirty minutes
if (! &EXT_cache_status($udom,$uname)) {
- my %resourcedata=&get('resourcedata',
- [$courselevelr,$courselevelm,$courselevel],
- $udom,$uname);
- my ($tmp)=keys(%resourcedata);
+ my $hashid="$udom:$uname";
+ my ($result,$cached)=&is_cached(\%userresdatacache,$hashid);
+ if (!defined($cached)) {
+ my %resourcedata=&get('resourcedata',
+ [$courselevelr,$courselevelm,
+ $courselevel],$udom,$uname);
+ $result=\%resourcedata;
+ }
+ my ($tmp)=keys(%$result);
if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
- if ($resourcedata{$courselevelr}) {
- return $resourcedata{$courselevelr}; }
- if ($resourcedata{$courselevelm}) {
- return $resourcedata{$courselevelm}; }
- if ($resourcedata{$courselevel}) {
- return $resourcedata{$courselevel}; }
+ &do_cache(\%userresdatacache,$hashid,$result);
+ if ($$result{$courselevelr}) {
+ return $$result{$courselevelr}; }
+ if ($$result{$courselevelm}) {
+ return $$result{$courselevelm}; }
+ if ($$result{$courselevel}) {
+ return $$result{$courselevel}; }
} else {
if ($tmp!~/No such file/) {
&logthis("<font color=blue>WARNING:".
" Trying to get resource data for ".
$uname." at ".$udom.": ".
$tmp."</font>");
+ &do_cache(\%userresdatacache,$hashid,undef);
} elsif ($tmp=~/error:No such file/) {
&EXT_cache_set($udom,$uname);
} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+ &do_cache(\%userresdatacache,$hashid,undef);
return $tmp;
}
}
@@ -3757,13 +3822,8 @@ sub gettitle {
unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
return &metadata($urlsymb,'title');
}
- if ($titlecache{$symb}) {
- if (time < ($titlecache{$symb}[1] + 600)) {
- return $titlecache{$symb}[0];
- } else {
- delete($titlecache{$symb});
- }
- }
+ my ($result,$cached)=&is_cached(\%titlecache,$symb,600);
+ if (defined($cached)) { return $result; }
my ($map,$resid,$url)=&decode_symb($symb);
my $title='';
my %bighash;
@@ -3775,8 +3835,7 @@ sub gettitle {
}
$title=~s/\&colon\;/\:/gs;
if ($title) {
- $titlecache{$symb}=[$title,time];
- return $title;
+ return &do_cache(\%titlecache,$symb,$title);
} else {
return &metadata($urlsymb,'title');
}
@@ -3856,7 +3915,18 @@ sub symbclean {
# ---------------------------------------------- Split symb to find map and url
sub decode_symb {
- return split(/\_\_\_/,shift);
+ my ($map,$resid,$url)=split(/\_\_\_/,shift);
+ return (&fixversion($map),$resid,&fixversion($url));
+}
+
+sub fixversion {
+ my $fn=shift;
+ if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
+ my ($match,$cond,$versioned)=&is_on_map($fn);
+ unless ($match) {
+ $fn=$versioned;
+ }
+ return $fn;
}
# ------------------------------------------------------ Return symb list entry
@@ -4158,6 +4228,12 @@ sub unescape {
return $str;
}
+sub mod_perl_version {
+ if (defined($perlvar{'MODPERL2'})) {
+ return 2;
+ }
+ return 1;
+}
# ================================================================ Main Program
sub goodbye {