--- rat/lonuserstate.pm 2002/06/26 15:44:35 1.30 +++ rat/lonuserstate.pm 2003/03/17 18:07:09 1.56 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Construct and maintain state and binary representation of course for user # -# $Id: lonuserstate.pm,v 1.30 2002/06/26 15:44:35 www Exp $ +# $Id: lonuserstate.pm,v 1.56 2003/03/17 18:07:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,7 +40,6 @@ # 11/1,11/2,11/14,11/16,11/22,12/28, # YEAR=2001 # 07/05/01,08/30,08/31 Gerd Kortemeyer -# 12/16 Scott Harrison # ### @@ -68,6 +67,12 @@ my @cond; # Array with all of the con my $errtext; # variable with all errors my $retfurl; # variable with the very first URL in the course my %randompick; # randomly picked resources +my %randompickseed; # optional seed for randomly picking resources +my %actualversion; # version of resource as loaded now +my %setversion; # forced version of resource +my %lastversion; # version when CC came in last +my $versionmode; # how versioning is handled in this course + # --------------------------------------------------------- Loads map from disk sub loadmap { @@ -79,7 +84,10 @@ sub loadmap { $hash{'map_pc_'.$uri}=$lpc; $hash{'map_id_'.$lpc}=$uri; - my $fn='/home/httpd/html'.$uri; +# Determine and check filename + my $fn=&Apache::lonnet::filelocation('',$uri); + + my $ispage=($fn=~/\.page$/); unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { @@ -87,32 +95,12 @@ sub loadmap { return OK; } - my $ispage=($fn=~/\.page$/); + my $instr=&Apache::lonnet::getfile($fn); - unless (-e $fn) { - my $returned=Apache::lonnet::repcopy($fn); - unless ($returned eq OK) { - $errtext.="Could not import: $fn - "; - if ($returned eq HTTP_SERVICE_UNAVAILABLE) { - $errtext.="Server unavailable\n"; - } - if ($returned eq HTTP_NOT_FOUND) { - $errtext.="File not found\n"; - } - if ($returned eq FORBIDDEN) { - $errtext.="Access forbidden\n"; - } - return OK; - } - } + unless ($instr == -1) { + +# Successfully got file, parse it - if (-e $fn) { - my @content; - { - my $fh=Apache::File->new($fn); - @content=<$fh>; - } - my $instr=join('',@content); my $parser = HTML::TokeParser->new(\$instr); my $token; @@ -132,25 +120,43 @@ sub loadmap { $hash{'kind_'.$rid}='res'; $hash{'title_'.$rid}=$token->[2]->{'title'}; my $turi=$token->[2]->{'src'}; + $Apache::lonnet::titlecache{ + &Apache::lonnet::symbclean( + &Apache::lonnet::declutter($uri).'___'. + $token->[2]->{'id'}.'___'. + &Apache::lonnet::declutter($turi))}= + $token->[2]->{'title'}; unless ($ispage) { $turi=~/\.(\w+)$/; my $embstyle=&Apache::loncommon::fileembstyle($1); - if ($token->[2]->{'external'} eq 'true') { + if ($token->[2]->{'external'} eq 'true') { # external $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; - } else { - my $embstyle=&Apache::loncommon::fileembstyle($1); + } elsif ($turi=~/^\/*uploaded\//) { # uploaded + if (($embstyle eq 'img') || ($embstyle eq 'emb') + || ($embstyle eq 'ssi')) { + $turi='/adm/wrapper'.$turi; + } elsif ($turi!~/\.(sequence|page)$/) { + $turi='/adm/coursedocs/showdoc'.$turi; + } + } else { # normal internal resource if (($embstyle eq 'img') || ($embstyle eq 'emb')) { $turi='/adm/wrapper'.$turi; } } } - $hash{'src_'.$rid}=$turi; if (defined($hash{'ids_'.$turi})) { $hash{'ids_'.$turi}.=','.$rid; } else { $hash{'ids_'.$turi}=''.$rid; } + + if + ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { + $turi.='?register=1'; + } + + $hash{'src_'.$rid}=$turi; if ($token->[2]->{'external'} eq 'true') { $hash{'ext_'.$rid}='true:'; @@ -239,6 +245,9 @@ sub loadmap { if ($token->[2]->{'name'} eq 'parameter_randompick') { $randompick{$referid}=$token->[2]->{'value'}; } + if ($token->[2]->{'name'} eq 'parameter_randompickseed') { + $randompick{$referid}=$token->[2]->{'value'}; + } } } @@ -277,9 +286,11 @@ sub traceroute { $sofar=simplify($sofar); unless ($beenhere=~/\&$rid\&/) { $beenhere.=$rid.'&'; - if ($retfurl eq '') { + if (($retfurl eq '') && ($hash{'src_'.$rid}) + && ($hash{'src_'.$rid}!~/\.sequence$/)) { my ($mapid,$resid)=split(/\./,$rid); - $retfurl=$hash{'src_'.$rid}.'?symb='. + $retfurl=$hash{'src_'.$rid}. + (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='. &Apache::lonnet::symbclean( &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). '___'.$resid.'___'. @@ -366,11 +377,11 @@ sub accinit { my $resid=$_; my $uri=$hash{'src_'.$resid}; $uri=~s/^\/adm\/wrapper//; + $uri=&Apache::lonnet::declutter($uri); my @uriparts=split(/\//,$uri); my $urifile=$uriparts[$#uriparts]; $#uriparts--; my $uripath=join('/',@uriparts); - $uripath=~s/^\/res\///; if ($uripath) { my $uricond='0'; if (defined($hash{'conditions_'.$resid})) { @@ -378,7 +389,7 @@ sub accinit { } if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ - /(\&$urifile\:[^\&]*)/) { + /(\&\Q$urifile\E\:[^\&]*)/) { my $replace=$1; my $regexp=$replace; $regexp=~s/\|/\\\|/g; @@ -409,35 +420,50 @@ sub accinit { # ------------------------------------- Selectively delete from randompick maps sub pickrandom { + my $randomoutentry=''; foreach my $rid (keys %randompick) { my $rndpick=$randompick{$rid}; my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; # ------------------------------------------- put existing resources into array my @currentrids=(); - foreach (keys %hash) { + foreach (sort(keys(%hash))) { if ($_=~/^src_($mpc\.\d+)/) { if ($hash{'src_'.$1}) { push @currentrids, $1; } } } + # rids are number.number and we want to numercially sort on + # the second number + @currentrids=sort { + my (undef,$aid)=split(/\./,$a); + my (undef,$bid)=split(/\./,$b); + $aid <=> $bid; + } @currentrids; next if ($#currentrids<$rndpick); # -------------------------------- randomly eliminate the ones that should stay - srand(&Apache::lonnet::rndseed($rid)); # use rid instead of symb - for (my $i=1;$i<=$#currentrids+1-$rndpick;$i++) { - while (1) { - my $randomidx=int(rand($#currentrids+1)); - if ($currentrids[$randomidx]) { - $currentrids[$randomidx]=''; - last; - } - } - } + my (undef,$id)=split(/\./,$rid); + if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; } + my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb + &Math::Random::random_set_seed_from_phrase($rndseed); + my @whichids=&Math::Random::random_permuted_index($#currentrids+1); + for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; } + #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids)); # -------------------------------------------------------- delete the leftovers for (my $k=0; $k<=$#currentrids; $k++) { if ($currentrids[$k]) { $hash{'randomout_'.$currentrids[$k]}=1; + my ($mapid,$resid)=split(/\./,$currentrids[$k]); + $randomoutentry.='&'. + &Apache::lonnet::symbclean( + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]}) + ).'&'; } } } + if ($randomoutentry) { + &Apache::lonnet::appenv('acc.randomout' => $randomoutentry); + } } # ---------------------------------------------------- Read map and all submaps @@ -461,13 +487,13 @@ sub readmap { unlink($fn.'parms.db'); undef %randompick; $retfurl=''; - if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) && - (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT,0640))) { + if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && + (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { %hash=(); %parmhash=(); $errtext=''; $pc=0; - my $furi='/res/'.&Apache::lonnet::declutter($uri); + my $furi=&Apache::lonnet::clutter($uri); $hash{'src_0.0'}=$furi; $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); $hash{'ids_'.$furi}='0.0'; @@ -478,6 +504,10 @@ sub readmap { &accinit($uri,$short,$fn); &pickrandom(); } +# ------------------------------------------------------------ Version tracking +# if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { +# &Apache::lonnet::logthis('Will be version tracking'); +# } unless ((untie(%hash)) && (untie(%parmhash))) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn for $uri."); @@ -496,6 +526,15 @@ sub readmap { "Could not tie coursemap $fn for $uri."); } &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); +# ------------------------------------------------- Check for critical messages + + my @what=&Apache::lonnet::dump('critical',$ENV{'user.domain'}, + $ENV{'user.name'}); + if ($what[0]) { + if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { + $retfurl='/adm/email?critical=display'; + } + } return ($retfurl,$errtext); } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.