--- rat/lonuserstate.pm 2002/07/07 17:52:20 1.33 +++ rat/lonuserstate.pm 2003/12/15 15:26:26 1.69 @@ -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.33 2002/07/07 17:52:20 www Exp $ +# $Id: lonuserstate.pm,v 1.69 2003/12/15 15:26:26 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,23 +25,6 @@ # # http://www.lon-capa.org/ # -# (Server for RAT Maps -# -# (Edit Handler for RAT Maps -# (TeX Content Handler -# -# YEAR=2000 -# 05/29/00,05/30 Gerd Kortemeyer) -# 7/1 Gerd Kortemeyer) -# 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer) -# -# 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30, -# 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31, -# 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 -# ### package Apache::lonuserstate; @@ -68,6 +51,50 @@ 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 + +# ----------------------------------- Remove version from URL and store in hash + +sub versiontrack { + my $uri=shift; + if ($uri=~/\.(\d+)\.\w+$/) { + my $version=$1; + $uri=~s/\.\d+\.(\w+)$/\.$1/; + unless ($hash{'version_'.$uri}) { + $hash{'version_'.$uri}=$version; + } + } + return $uri; +} + +# -------------------------------------------------------------- Put in version + +sub putinversion { + my $uri=shift; + if ($hash{'version_'.$uri}) { + my $version=$hash{'version_'.$uri}; + if ($version eq 'mostrecent') { return $uri; } + if ($version eq &Apache::lonnet::getversion( + &Apache::lonnet::filelocation('',$uri))) + { return $uri; } + $uri=~s/\.(\w+)$/\.$version\.$1/; + } + return $uri; +} + +# ----------------------------------------- Processing versions file for course + +sub processversionfile { + my %cenv=@_; + my %versions=&Apache::lonnet::dump('resourceversions', + $cenv{'domain'}, + $cenv{'num'}); + foreach (keys %versions) { + if ($_=~/^error\:/) { return; } + $hash{'version_'.$_}=$versions{$_}; + } +} + # --------------------------------------------------------- Loads map from disk sub loadmap { @@ -79,7 +106,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('',&putinversion($uri)); + + my $ispage=($fn=~/\.page$/); unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { @@ -87,32 +117,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 eq -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; @@ -131,26 +141,50 @@ sub loadmap { $hash{'kind_'.$rid}='res'; $hash{'title_'.$rid}=$token->[2]->{'title'}; - my $turi=$token->[2]->{'src'}; + my $turi=&versiontrack($token->[2]->{'src'}); + if ($token->[2]->{'version'}) { + unless ($hash{'version_'.$turi}) { + $hash{'version_'.$turi}=$1; + } + } + &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache, + &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'}, + $turi), + $token->[2]->{'title'},'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; + } + } elsif ($turi) { # normal non-empty internal resource + my $mapdir=$uri; + $mapdir=~s/[^\/]+$//; + $turi=&Apache::lonnet::hreflocation($mapdir,$turi); + 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:'; @@ -221,12 +255,17 @@ sub loadmap { # ------------------------------------------------------------------- Parameter my $referid=$lpc.'.'.$token->[2]->{'to'}; - my $part=$token->[2]->{'part'}; - unless ($part) { $part=0; } + my $name=$token->[2]->{'name'}; + my $part; + if ($name=~/^parameter_(.*)_/) { + $part=$1; + } else { + $part=0; + } + $name=~s/^.*_([^_]*)$/$1/; my $newparam= &Apache::lonnet::escape($token->[2]->{'type'}).':'. - &Apache::lonnet::escape($part.'.'. - $token->[2]->{'name'}).'='. + &Apache::lonnet::escape($part.'.'.$name).'='. &Apache::lonnet::escape($token->[2]->{'value'}); if (defined($hash{'param_'.$referid})) { $hash{'param_'.$referid}.='&'.$newparam; @@ -239,6 +278,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 +319,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 +410,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 +422,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; @@ -415,23 +459,27 @@ sub pickrandom { 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<=$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 + &Apache::lonnet::setup_random_from_rndseed($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]) { @@ -472,14 +520,15 @@ 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); - $hash{'src_0.0'}=$furi; + &processversionfile(%cenv); + my $furi=&Apache::lonnet::clutter($uri); + $hash{'src_0.0'}=&versiontrack($furi); $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); $hash{'ids_'.$furi}='0.0'; $hash{'is_map_0.0'}=1; @@ -489,6 +538,12 @@ sub readmap { &accinit($uri,$short,$fn); &pickrandom(); } +# ------------------------------------------------------- Put versions into src + foreach (keys %hash) { + if ($_=~/^src\_/) { + $hash{$_}=&putinversion($hash{$_}); + } + } unless ((untie(%hash)) && (untie(%parmhash))) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn for $uri."); @@ -507,6 +562,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); }