--- rat/lonuserstate.pm 2002/06/26 15:44:35 1.30 +++ rat/lonuserstate.pm 2003/02/28 16:17:00 1.52 @@ -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.52 2003/02/28 16:17:00 www 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,15 +120,28 @@ 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); - if (($embstyle eq 'img') || ($embstyle eq 'emb')) { - $turi='/adm/wrapper'.$turi; + } 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=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/)) { + $turi=$turi.'?register=1'; } } } @@ -239,6 +240,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 +281,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.'___'. @@ -409,35 +415,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 +482,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 +499,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 +521,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); }