--- rat/lonuserstate.pm 2002/09/04 19:37:32 1.41 +++ rat/lonuserstate.pm 2005/01/19 20:18:44 1.78.2.1 @@ -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.41 2002/09/04 19:37:32 www Exp $ +# $Id: lonuserstate.pm,v 1.78.2.1 2005/01/19 20:18:44 albertel 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; @@ -58,6 +41,7 @@ use Apache::lonmsg; use Safe; use Safe::Hole; use Opcode; +use Apache::lonenc; # ---------------------------------------------------- Globals for this package @@ -68,6 +52,52 @@ 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 %encurl; # URLs in this folder are supposed to be encrypted +my %hiddenurl; # this URL (or complete folder) is supposed to be hidden + +# ----------------------------------- 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 { @@ -80,7 +110,7 @@ sub loadmap { $hash{'map_id_'.$lpc}=$uri; # Determine and check filename - my $fn=&Apache::lonnet::filelocation('',$uri); + my $fn=&Apache::lonnet::filelocation('',&putinversion($uri)); my $ispage=($fn=~/\.page$/); @@ -92,7 +122,7 @@ sub loadmap { my $instr=&Apache::lonnet::getfile($fn); - unless ($instr == -1) { + unless ($instr eq -1) { # Successfully got file, parse it @@ -114,34 +144,53 @@ 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') { # external $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; } elsif ($turi=~/^\/*uploaded\//) { # uploaded - if (($embstyle eq 'img') || ($embstyle eq 'emb') - || ($embstyle eq 'ssi')) { + if (($embstyle eq 'img') || ($embstyle eq 'emb')) { $turi='/adm/wrapper'.$turi; - } elsif ($turi!~/\.(sequence|page)$/) { - $turi='/adm/coursedocs?showdoc='.$turi; + } elsif ($embstyle eq 'ssi') { + #do nothing with these + } elsif ($turi!~/\.(sequence|page)$/) { + $turi='/adm/coursedocs/showdoc'.$turi; } - } else { # normal internal resource - if (($embstyle eq 'img') || ($embstyle eq 'emb') - || ($turi=~/\/syllabus$/) || ($turi=~/\/aboutme$/) - || ($turi=~/\/navmaps$/)) { - $turi='/adm/wrapper'.$turi; - } + } elsif ($turi=~/\S/) { # 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; +# Store reverse lookup, remove query string + my $idsuri=$turi; + $idsuri=~s/\?.+$//; + if (defined($hash{'ids_'.$idsuri})) { + $hash{'ids_'.$idsuri}.=','.$rid; } else { - $hash{'ids_'.$turi}=''.$rid; + $hash{'ids_'.$idsuri}=''.$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:'; @@ -212,24 +261,42 @@ 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; } else { $hash{'param_'.$referid}=''.$newparam; } - if ($token->[2]->{'name'} eq 'parameter_mapalias') { + if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; } - if ($token->[2]->{'name'} eq 'parameter_randompick') { + if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { $randompick{$referid}=$token->[2]->{'value'}; } + if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { + $randompick{$referid}=$token->[2]->{'value'}; + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { + if ($token->[2]->{'value'}=~/^yes$/i) { + $hiddenurl{$referid}=1; + } + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { + if ($token->[2]->{'value'}=~/^yes$/i) { + $hiddenurl{$referid}=1; + } + } } } @@ -264,11 +331,18 @@ sub simplify { # -------------------------------------------------------- Build condition hash sub traceroute { - my ($sofar,$rid,$beenhere)=@_; + my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; $sofar=simplify($sofar); unless ($beenhere=~/\&$rid\&/) { $beenhere.=$rid.'&'; - if (($retfurl eq '') && ($hash{'src_'.$rid})) { + if ($hdnflag) { + $hiddenurl{$rid}=1; + } + if ($encflag) { + $encurl{$rid}=1; + } + if (($retfurl eq '') && ($hash{'src_'.$rid}) + && ($hash{'src_'.$rid}!~/\.sequence$/)) { my ($mapid,$resid)=split(/\./,$rid); $retfurl=$hash{'src_'.$rid}. (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='. @@ -285,7 +359,9 @@ sub traceroute { } if (defined($hash{'is_map_'.$rid})) { if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { - &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&'); + &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&', + $encflag || $encurl{$rid}, + $hdnflag || $hiddenurl{$rid}); if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) { $sofar= $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}}; @@ -304,7 +380,7 @@ sub traceroute { .$hash{'undercond_'.$_}.'. '; } } - &traceroute($further,$hash{'goesto_'.$_},$beenhere); + &traceroute($further,$hash{'goesto_'.$_},$beenhere,$encflag,$hdnflag); } } } @@ -358,11 +434,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})) { @@ -370,12 +446,12 @@ 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; + #$regexp=~s/\|/\\\|/g; $acchash{'acc.res.'.$short.'.'.$uripath} - =~s/$regexp/$replace\|$uricond/; + =~s/\Q$regexp\E/$replace\|$uricond/; } else { $acchash{'acc.res.'.$short.'.'.$uripath}.= $urifile.':'.$uricond.'&'; @@ -398,32 +474,36 @@ sub accinit { "request.course.uri" => $courseuri); } -# ------------------------------------- Selectively delete from randompick maps +# ---------------- Selectively delete from randompick maps and hidden url parms -sub pickrandom { +sub hiddenurls { 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<=$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]) { @@ -438,6 +518,18 @@ sub pickrandom { } } } +# ------------------------------ take care of explicitly hidden urls or folders + foreach my $rid (keys %hiddenurl) { + $hash{'randomout_'.$rid}=1; + my ($mapid,$resid)=split(/\./,$rid); + $randomoutentry.='&'. + &Apache::lonnet::symbclean( + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &Apache::lonnet::declutter($hash{'src_'.$rid}) + ).'&'; + } +# --------------------------------------- append randomout entry to environment if ($randomoutentry) { &Apache::lonnet::appenv('acc.randomout' => $randomoutentry); } @@ -463,6 +555,8 @@ sub readmap { unlink($fn.'.state'); unlink($fn.'parms.db'); undef %randompick; + undef %hiddenurl; + undef %encurl; $retfurl=''; if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { @@ -470,8 +564,9 @@ sub readmap { %parmhash=(); $errtext=''; $pc=0; + &processversionfile(%cenv); my $furi=&Apache::lonnet::clutter($uri); - $hash{'src_0.0'}=$furi; + $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; @@ -479,12 +574,25 @@ sub readmap { if (defined($hash{'map_start_'.$uri})) { &traceroute('0',$hash{'map_start_'.$uri},'&'); &accinit($uri,$short,$fn); - &pickrandom(); + &hiddenurls(); + } +# ------------------------------------------------------- Put versions into src + foreach (keys %hash) { + if ($_=~/^src\_/) { + $hash{$_}=&putinversion($hash{$_}); + } + } +# ---------------------------------------------------------------- Encrypt URLs + foreach (keys %encurl) { + $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_}); } +# ----------------------------------------------- Close hashes to finally store +# --------------------------------- Routine must pass this point, no early outs unless ((untie(%hash)) && (untie(%parmhash))) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn for $uri."); } +# ---------------------------------------------------- Store away initial state { my $cfh; if ($cfh=Apache::File->new(">$fn.state")) { @@ -499,6 +607,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); }