--- loncom/lonnet/perl/lonnet.pm 2004/10/06 09:48:39 1.550 +++ loncom/lonnet/perl/lonnet.pm 2004/10/26 15:15:18 1.553 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.550 2004/10/06 09:48:39 foxr Exp $ +# $Id: lonnet.pm,v 1.553 2004/10/26 15:15:18 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,7 +39,7 @@ qw(%perlvar %hostname %homecache %badSer %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache %courselogs %accesshash %userrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache - %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def + %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir); use IO::Socket; @@ -798,6 +798,11 @@ sub getsection { my ($udom,$unam,$courseid)=@_; $courseid=~s/\_/\//g; $courseid=~s/^(\w)/\/$1/; + + my $hashid="$udom:$unam:$courseid"; + my ($result,$cached)=&is_cached(\%getsectioncache,$hashid,'getsection'); + if (defined($cached)) { return $result; } + my %Pending; my %Expired; # @@ -830,25 +835,25 @@ sub getsection { $Pending{$start}=$section; next; } - return $section; + return &do_cache(\%getsectioncache,$hashid,$section,'getsection'); } # # Presumedly there will be few matching roles from the above # loop and the sorting time will be negligible. if (scalar(keys(%Pending))) { my ($time) = sort {$a <=> $b} keys(%Pending); - return $Pending{$time}; + return &do_cache(\%getsectioncache,$hashid,$Pending{$time},'getsection'); } if (scalar(keys(%Expired))) { my @sorted = sort {$a <=> $b} keys(%Expired); my $time = pop(@sorted); - return $Expired{$time}; + return &do_cache(\%getsectioncache,$hashid,$Expired{$time},'getsection'); } - return '-1'; + return &do_cache(\%getsectioncache,$hashid,'-1','getsection'); } -my $disk_caching_disabled=0; +my $disk_caching_disabled=1; sub devalidate_cache { my ($cache,$id,$name) = @_; @@ -1035,38 +1040,6 @@ EVALBLOCK # &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); } -sub usection { - my ($udom,$unam,$courseid)=@_; - my $hashid="$udom:$unam:$courseid"; - - my ($result,$cached)=&is_cached(\%usectioncache,$hashid,'usection'); - if (defined($cached)) { return $result; } - $courseid=~s/\_/\//g; - $courseid=~s/^(\w)/\/$1/; - foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', - &homeserver($unam,$udom)))) { - my ($key,$value)=split(/\=/,$_); - $key=&unescape($key); - if ($key=~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/) { - my $section=$1; - if ($key eq $courseid.'_st') { $section=''; } - my ($dummy,$end,$start)=split(/\_/,&unescape($value)); - my $now=time; - my $notactive=0; - if ($start) { - if ($now<$start) { $notactive=1; } - } - if ($end) { - if ($now>$end) { $notactive=1; } - } - unless ($notactive) { - return &do_cache(\%usectioncache,$hashid,$section,'usection'); - } - } - } - return &do_cache(\%usectioncache,$hashid,'-1','usection'); -} - # ------------------------------------- Read an entry from a user's environment sub userenvironment { @@ -1900,6 +1873,7 @@ sub devalidate { # - the student level sheet of this user in course's homespace # - the assessment level sheet for this resource # for this user in user's homespace + # - current conditional state info my $key=$uname.':'.$udom.':'; my $status= &del('nohist_calculatedsheets', @@ -1914,6 +1888,7 @@ sub devalidate { $uname.' at '.$udom.' for '. $symb.': '.$status); } + &delenv('user.state.'.$cid); } } @@ -3083,6 +3058,9 @@ sub allowed { return ''; } } + if (!defined($ENV{'user.state.'.$ENV{'request.course.id'}})) { + &Apache::lonuserstate::evalstate(); + } if (&condval($statecond)) { return '2'; } else { @@ -4142,7 +4120,7 @@ sub EXT { $section=$ENV{'request.course.sec'}; } else { if (! defined($usection)) { - $section=&usection($udom,$uname,$courseid); + $section=&getsection($udom,$uname,$courseid); } else { $section = $usection; } @@ -5118,13 +5096,15 @@ sub repcopy_userfile { sub tokenwrapper { my $uri=shift; - $uri=~s/^http\:\/\/([^\/]+)//; - $uri=~s/^\///; + $uri=~s|^http\://([^/]+)||; + $uri=~s|^/||; $ENV{'user.environment'}=~/\/([^\/]+)\.id/; my $token=$1; - if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { - &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); - return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. + my (undef,$udom,$uname,$file)=split('/',$uri,4); + if ($udom && $uname && $file) { + $file=~s|(\?\.*)*$||; + &appenv("userfile.$udom/$uname/$file" => $ENV{'request.course.id'}); + return 'http://'.$hostname{ &homeserver($uname,$udom)}.'/'.$uri. (($uri=~/\?/)?'&':'?').'token='.$token. '&tokenissued='.$perlvar{'lonHostID'}; } else { @@ -5298,7 +5278,7 @@ sub goodbye { &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache))); #1.1 only &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); - &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache))); + &logthis(sprintf("%-20s is %s",'%getsectioncache',scalar(%getsectioncache))); &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache))); &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache))); &flushcourselogs(); @@ -5680,8 +5660,8 @@ X B: get user privileges =item * -X -B: finds the section of student in the +X +B: finds the section of student in the course $cname, return section name/number or '' for "not in course" and '-1' for "no section"