--- rat/lonuserstate.pm 2003/10/22 16:10:56 1.61 +++ rat/lonuserstate.pm 2006/02/23 08:38:54 1.99.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.61 2003/10/22 16:10:56 www Exp $ +# $Id: lonuserstate.pm,v 1.99.2.1 2006/02/23 08:38:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,38 +25,22 @@ # # 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 -# ### package Apache::lonuserstate; # ------------------------------------------------- modules used by this module use strict; -use Apache::Constants qw(:common :http); -use Apache::File; use HTML::TokeParser; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); use GDBM_File; use Apache::lonmsg; use Safe; use Safe::Hole; use Opcode; +use Apache::lonenc; +use Fcntl qw(:flock); # ---------------------------------------------------- Globals for this package @@ -68,6 +52,8 @@ 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 @@ -76,7 +62,9 @@ sub versiontrack { if ($uri=~/\.(\d+)\.\w+$/) { my $version=$1; $uri=~s/\.\d+\.(\w+)$/\.$1/; - $hash{'version_'.$uri}=$version; + unless ($hash{'version_'.$uri}) { + $hash{'version_'.$uri}=$version; + } } return $uri; } @@ -85,27 +73,29 @@ sub versiontrack { sub putinversion { my $uri=shift; + my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri); 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/; } + &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); return $uri; } # ----------------------------------------- Processing versions file for course sub processversionfile { - my %cenv=shift; + my %cenv=@_; my %versions=&Apache::lonnet::dump('resourceversions', $cenv{'domain'}, $cenv{'num'}); foreach (keys %versions) { if ($_=~/^error\:/) { return; } - if ($versions{$_} eq 'current') { - delete $hash{'version_'.$_}; - } else { - $hash{'version_'.$_}=$versions{$_}; - } + $hash{'version_'.$_}=$versions{$_}; } } @@ -113,7 +103,7 @@ sub processversionfile { sub loadmap { my $uri=shift; - if ($hash{'map_pc_'.$uri}) { return OK; } + if ($hash{'map_pc_'.$uri}) { return; } $pc++; my $lpc=$pc; @@ -121,14 +111,14 @@ 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$/); unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { - $errtext.="Invalid map: $fn\n"; - return OK; + $errtext.="Invalid map: $fn\n"; + return; } my $instr=&Apache::lonnet::getfile($fn); @@ -138,6 +128,7 @@ sub loadmap { # Successfully got file, parse it my $parser = HTML::TokeParser->new(\$instr); + $parser->attr_encoded(1); my $token; my $linkpc=0; @@ -150,50 +141,59 @@ sub loadmap { if ($token->[0] eq 'S') { if ($token->[1] eq 'resource') { # -------------------------------------------------------------------- Resource - + if ($token->[2]->{'type'} eq 'zombie') { next; } my $rid=$lpc.'.'.$token->[2]->{'id'}; $hash{'kind_'.$rid}='res'; $hash{'title_'.$rid}=$token->[2]->{'title'}; -# Rip out the version and store it separately my $turi=&versiontrack($token->[2]->{'src'}); -# If there is an explicit version parameter, use that one if ($token->[2]->{'version'}) { - $hash{'version_'.$turi}=$1; + unless ($hash{'version_'.$turi}) { + $hash{'version_'.$turi}=$1; + } } - &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache, - &Apache::lonnet::symbclean( - &Apache::lonnet::declutter($uri).'___'. - $token->[2]->{'id'}.'___'. - &Apache::lonnet::declutter($turi)), - $token->[2]->{'title'}); + my $title=$token->[2]->{'title'}; + $title=~s/\&colon\;/\:/gs; +# my $symb=&Apache::lonnet::encode_symb($uri, +# $token->[2]->{'id'}, +# $turi); +# &Apache::lonnet::do_cache_new('title',$symb,$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') + || ($embstyle eq 'wrp')) { $turi='/adm/wrapper'.$turi; - } elsif ($turi!~/\.(sequence|page)$/) { + } 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='/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') + || ($embstyle eq 'wrp')) { + $turi='/adm/wrapper'.$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)$/) { + if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { $turi.='?register=1'; } @@ -268,106 +268,134 @@ 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'} eq 'parameter_randompickseed') { + 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) { + $encurl{$referid}=1; + } + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { + if ($token->[2]->{'value'}=~/^yes$/i) { + $hiddenurl{$referid}=1; + } + } } - + } } } else { - $errtext.='Map not loaded: The file does not exist. '; + $errtext.='Map not loaded: The file ('.$fn.') does not exist. '; } } # --------------------------------------------------------- Simplify expression sub simplify { - my $expression=shift; + my $expression=shift; +# (0&1) = 1 + $expression=~s/\(0\&(\d+)\)/$1/g; # (8)=8 - $expression=~s/\((\d+)\)/$1/g; + $expression=~s/\((\d+)\)/$1/g; # 8&8=8 - $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; + $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; # 8|8=8 - $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g; + $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g; # (5&3)&4=5&3&4 - $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g; + $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g; # (((5&3)|(4&6)))=((5&3)|(4&6)) - $expression=~ - s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; +# $expression=~ +# s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) - $expression=~ - s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g; - return $expression; + $expression=~ + s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g; + return $expression; } # -------------------------------------------------------- Build condition hash sub traceroute { - my ($sofar,$rid,$beenhere)=@_; - $sofar=simplify($sofar); + my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; + my $newsofar=$sofar=simplify($sofar); unless ($beenhere=~/\&$rid\&/) { - $beenhere.=$rid.'&'; - if (($retfurl eq '') && ($hash{'src_'.$rid}) - && ($hash{'src_'.$rid}!~/\.sequence$/)) { - my ($mapid,$resid)=split(/\./,$rid); - $retfurl=$hash{'src_'.$rid}. - (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='. - &Apache::lonnet::symbclean( - &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). - '___'.$resid.'___'. - &Apache::lonnet::declutter($hash{'src_'.$rid})); - } - if (defined($hash{'conditions_'.$rid})) { - $hash{'conditions_'.$rid}=simplify( + $beenhere.=$rid.'&'; + my ($mapid,$resid)=split(/\./,$rid); + my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); + my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb); + + if ($hdnflag || lc($hidden) eq 'yes') { + $hiddenurl{$rid}=1; + } + if (!$hdnflag && lc($hidden) eq 'no') { + delete($hiddenurl{$rid}); + } + + my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); + if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } + if (($retfurl eq '') && ($hash{'src_'.$rid}) + && ($hash{'src_'.$rid}!~/\.sequence$/)) { + $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?'). + 'symb='.$symb; + } + if (defined($hash{'conditions_'.$rid})) { + $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); - } else { - $hash{'conditions_'.$rid}=$sofar; - } - if (defined($hash{'is_map_'.$rid})) { - if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { - &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&'); - if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) { - $sofar= - $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}}; - } - } - } - if (defined($hash{'to_'.$rid})) { - foreach (split(/\,/,$hash{'to_'.$rid})) { + } else { + $hash{'conditions_'.$rid}=$sofar; + } + $newsofar=$hash{'conditions_'.$rid}; + if (defined($hash{'is_map_'.$rid})) { + if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { + $sofar=$newsofar= + &traceroute($sofar, + $hash{'map_start_'.$hash{'src_'.$rid}},'&', + $encflag || $encurl{$rid}, + $hdnflag || $hiddenurl{$rid}); + } + } + if (defined($hash{'to_'.$rid})) { + foreach (split(/\,/,$hash{'to_'.$rid})) { my $further=$sofar; if ($hash{'undercond_'.$_}) { - if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) { - $further=simplify('('.$further.')&('. - $hash{'condid_'.$hash{'undercond_'.$_}}.')'); - } else { - $errtext.='Undefined condition ID: ' - .$hash{'undercond_'.$_}.'. '; - } + if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) { + $further=simplify('('.$further.')&('. + $hash{'condid_'.$hash{'undercond_'.$_}}.')'); + } else { + $errtext.='Undefined condition ID: ' + .$hash{'undercond_'.$_}.'. '; + } } - &traceroute($further,$hash{'goesto_'.$_},$beenhere); - } - } + $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere, + $encflag,$hdnflag); + } + } } + return $newsofar; } # ------------------------------ Cascading conditions, quick access, parameters @@ -379,88 +407,85 @@ sub accinit { my $condcounter=0; $acchash{'acc.cond.'.$short.'.0'}=0; foreach (keys %hash) { - if ($_=~/^conditions/) { - my $expr=$hash{$_}; - foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) { - my $sub=$_; - my $orig=$_; - $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; - my $factor=$1; - $sub=~s/$factor//g; - $sub=~s/^\(/\($factor\(/; - $sub.=')'; - $sub=simplify($sub); - $orig=~s/(\W)/\\$1/g; - $expr=~s/$orig/$sub/; - } - $hash{$_}=$expr; - unless (defined($captured{$expr})) { - $condcounter++; - $captured{$expr}=$condcounter; - $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; - } - } elsif ($_=~/^param_(\d+)\.(\d+)/) { - my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}). - '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2}); - foreach (split(/\&/,$hash{$_})) { - my ($typename,$value)=split(/\=/,$_); - my ($type,$name)=split(/\:/,$typename); - $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}= - &Apache::lonnet::unescape($type); - } - } + if ($_=~/^conditions/) { + my $expr=$hash{$_}; + foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) { + my $sub=$_; + my $orig=$_; + $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; + my $factor=$1; + $sub=~s/$factor//g; + $sub=~s/^\(/\($factor\(/; + $sub.=')'; + $sub=simplify($sub); + $orig=~s/(\W)/\\$1/g; + $expr=~s/$orig/$sub/; + } + $hash{$_}=$expr; + unless (defined($captured{$expr})) { + $condcounter++; + $captured{$expr}=$condcounter; + $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; + } + } elsif ($_=~/^param_(\d+)\.(\d+)/) { + my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2, + $hash{'src_'.$1.'.'.$2}); + foreach (split(/\&/,$hash{$_})) { + my ($typename,$value)=split(/\=/,$_); + my ($type,$name)=split(/\:/,$typename); + $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}= + &Apache::lonnet::unescape($type); + } + } } foreach (keys %hash) { if ($_=~/^ids/) { - foreach (split(/\,/,$hash{$_})) { - 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); - if ($uripath) { - my $uricond='0'; - if (defined($hash{'conditions_'.$resid})) { - $uricond=$captured{$hash{'conditions_'.$resid}}; - } - if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { - if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ - /(\&\Q$urifile\E\:[^\&]*)/) { - my $replace=$1; - my $regexp=$replace; - $regexp=~s/\|/\\\|/g; - $acchash{'acc.res.'.$short.'.'.$uripath} - =~s/$regexp/$replace\|$uricond/; - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}.= - $urifile.':'.$uricond.'&'; - } - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}= - '&'.$urifile.':'.$uricond.'&'; - } - } - } - } + foreach (split(/\,/,$hash{$_})) { + 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); + if ($uripath) { + my $uricond='0'; + if (defined($hash{'conditions_'.$resid})) { + $uricond=$captured{$hash{'conditions_'.$resid}}; + } + if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { + if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ + /(\&\Q$urifile\E\:[^\&]*)/) { + my $replace=$1; + my $regexp=$replace; + #$regexp=~s/\|/\\\|/g; + $acchash{'acc.res.'.$short.'.'.$uripath} + =~s/\Q$regexp\E/$replace\|$uricond/; + } else { + $acchash{'acc.res.'.$short.'.'.$uripath}.= + $urifile.':'.$uricond.'&'; + } + } else { + $acchash{'acc.res.'.$short.'.'.$uripath}= + '&'.$urifile.':'.$uricond.'&'; + } + } + } + } } $acchash{'acc.res.'.$short.'.'}='&:0&'; my $courseuri=$uri; $courseuri=~s/^\/res\///; &Apache::lonnet::delenv('(acc\.|httpref\.)'); - &Apache::lonnet::appenv(%acchash, - "request.course.id" => $short, - "request.course.fn" => $fn, - "request.course.uri" => $courseuri); + &Apache::lonnet::appenv(%acchash); } -# ------------------------------------- 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}; @@ -494,14 +519,22 @@ sub pickrandom { $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]}) - ).'&'; + &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, + $resid, + $hash{'src_'.$currentrids[$k]} + ).'&'; } } } +# ------------------------------ 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::encode_symb($hash{'map_id_'.$mapid},$resid, + $hash{'src_'.$rid}).'&'; + } +# --------------------------------------- append randomout entry to environment if ($randomoutentry) { &Apache::lonnet::appenv('acc.randomout' => $randomoutentry); } @@ -510,116 +543,168 @@ sub pickrandom { # ---------------------------------------------------- Read map and all submaps sub readmap { - my $short=shift; - $short=~s/^\///; - my %cenv=&Apache::lonnet::coursedescription($short); - my $fn=$cenv{'fn'}; - my $uri; - $short=~s/\//\_/g; - unless ($uri=$cenv{'url'}) { - &Apache::lonnet::logthis("WARNING: ". - "Could not load course $short."); - return 'No course data available.'; - } - @cond=('true:normal'); - unlink($fn.'.db'); - unlink($fn.'_symb.db'); - unlink($fn.'.state'); - 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))) { - %hash=(); - %parmhash=(); - $errtext=''; - $pc=0; - 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; - loadmap($uri); - if (defined($hash{'map_start_'.$uri})) { - &traceroute('0',$hash{'map_start_'.$uri},'&'); - &accinit($uri,$short,$fn); - &pickrandom(); - } -# ------------------------------------------------------------ Version tracking - &processversionfile(%cenv); - foreach (keys %hash) { - if ($_=~/^src\_/) { - $hash{$_}=&putinversion($hash{$_}); + my $short=shift; + $short=~s/^\///; + my %cenv=&Apache::lonnet::coursedescription($short); + my $fn=$cenv{'fn'}; + my $uri; + $short=~s/\//\_/g; + unless ($uri=$cenv{'url'}) { + &Apache::lonnet::logthis("WARNING: ". + "Could not load course $short."); + return 'No course data available.'; + } + @cond=('true:normal'); + + open(LOCKFILE,">$fn.db.lock"); + my $lock=0; + if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { + $lock=1; + unlink($fn.'.db'); + unlink($fn.'_symb.db'); + unlink($fn.'.state'); + unlink($fn.'parms.db'); + } + undef %randompick; + undef %hiddenurl; + undef %encurl; + $retfurl=''; + if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && + (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { + %hash=(); + %parmhash=(); + $errtext=''; + $pc=0; + &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; + loadmap($uri); + if (defined($hash{'map_start_'.$uri})) { + &Apache::lonnet::appenv("request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $uri); + &traceroute('0',$hash{'map_start_'.$uri},'&'); + &accinit($uri,$short,$fn); + &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_'.$_}); + $hash{'encrypted_'.$_}=1; + } +# ----------------------------------------------- Close hashes to finally store +# --------------------------------- Routine must pass this point, no early outs + $hash{'first_url'}=$retfurl; + unless ((untie(%hash)) && (untie(%parmhash))) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie coursemap $fn for $uri."); + } +# ---------------------------------------------------- Store away initial state + { + my $cfh; + if (open($cfh,">$fn.state")) { + print $cfh join("\n",@cond); + } else { + &Apache::lonnet::logthis("WARNING: ". + "Could not write statemap $fn for $uri."); + } } + flock(LOCKFILE,LOCK_UN); + close(LOCKFILE); + } else { + # if we are here it is likely because we are already trying to + # initialize the course in another child, busy wait trying to + # tie the hashes for the next 90 seconds, if we succeed forward + # them on to navmaps, if we fail, throw up the Could not init + # course screen + if ($lock) { + # Got the lock but not the DB files + flock(LOCKFILE,LOCK_UN); + } + untie(%hash); + untie(%parmhash); + &Apache::lonnet::logthis("WARNING: ". + "Could not tie coursemap $fn for $uri."); + my $i=0; + while($i<90) { + $i++; + sleep(1); + if (flock(LOCKFILE,LOCK_EX|LOCK_NB) && + (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) { + if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) { + $retfurl='/adm/navmaps'; + &Apache::lonnet::appenv("request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $uri); + untie(%hash); + untie(%parmhash); + last; + } + } + untie(%hash); + untie(%parmhash); + } + flock(LOCKFILE,LOCK_UN); + close(LOCKFILE); } - unless ((untie(%hash)) && (untie(%parmhash))) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn for $uri."); - } - { - my $cfh; - if ($cfh=Apache::File->new(">$fn.state")) { - print $cfh join("\n",@cond); - } else { - &Apache::lonnet::logthis("WARNING: ". - "Could not write statemap $fn for $uri."); - } - } - } else { - &Apache::lonnet::logthis("WARNING: ". - "Could not tie coursemap $fn for $uri."); - } - &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); + &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'}); + 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); + return ($retfurl,$errtext); } # ------------------------------------------------------- Evaluate state string sub evalstate { - - my $fn=$ENV{'request.course.fn'}.'.state'; - my $state='2'; + my $fn=$env{'request.course.fn'}.'.state'; + my $state=''; if (-e $fn) { - my @conditions=(); - { - my $fh=Apache::File->new($fn); - @conditions=<$fh>; - } - my $safeeval = new Safe; - my $safehole = new Safe::Hole; - $safeeval->permit("entereval"); - $safeeval->permit(":base_math"); - $safeeval->deny(":base_io"); - $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); - foreach (@conditions) { - my $line=$_; - chomp($line); - my ($condition,$weight)=split(/\:/,$_); - if ($safeeval->reval($condition)) { - if ($weight eq 'force') { - $state.='3'; - } else { - $state.='2'; - } - } else { - if ($weight eq 'stop') { - $state.='0'; - } else { - $state.='1'; - } - } - } + my @conditions=(); + { + my $fh=Apache::File->new($fn); + @conditions=<$fh>; + } + my $safeeval = new Safe; + my $safehole = new Safe::Hole; + $safeeval->permit("entereval"); + $safeeval->permit(":base_math"); + $safeeval->deny(":base_io"); + $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); + foreach my $line (@conditions) { + chomp($line); + my ($condition,$weight)=split(/\:/,$line); + if ($safeeval->reval($condition)) { + if ($weight eq 'force') { + $state.='3'; + } else { + $state.='2'; + } + } else { + if ($weight eq 'stop') { + $state.='0'; + } else { + $state.='1'; + } + } + } } - &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state); + &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state); return $state; }