--- rat/lonuserstate.pm 2005/07/15 12:29:07 1.95 +++ rat/lonuserstate.pm 2006/05/30 17:15:10 1.114 @@ -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.95 2005/07/15 12:29:07 www Exp $ +# $Id: lonuserstate.pm,v 1.114 2006/05/30 17:15:10 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,9 +31,9 @@ package Apache::lonuserstate; # ------------------------------------------------- modules used by this module use strict; -use Apache::Constants qw(:common :http); use HTML::TokeParser; use Apache::lonnet; +use Apache::lonlocal; use Apache::loncommon(); use GDBM_File; use Apache::lonmsg; @@ -41,6 +41,10 @@ use Safe; use Safe::Hole; use Opcode; use Apache::lonenc; +use Fcntl qw(:flock); +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + # ---------------------------------------------------- Globals for this package @@ -93,9 +97,9 @@ sub processversionfile { my %versions=&Apache::lonnet::dump('resourceversions', $cenv{'domain'}, $cenv{'num'}); - foreach (keys %versions) { - if ($_=~/^error\:/) { return; } - $hash{'version_'.$_}=$versions{$_}; + foreach my $ver (keys(%versions)) { + if ($ver=~/^error\:/) { return; } + $hash{'version_'.$ver}=$versions{$ver}; } } @@ -103,8 +107,10 @@ sub processversionfile { sub loadmap { my $uri=shift; - if ($hash{'map_pc_'.$uri}) { return OK; } - + if ($hash{'map_pc_'.$uri}) { + $errtext.=&mt('
Multiple use of sequence/page [_1]! The course will not function properly.',$uri); + return; + } $pc++; my $lpc=$pc; $hash{'map_pc_'.$uri}=$lpc; @@ -117,8 +123,8 @@ sub loadmap { unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { - $errtext.="Invalid map: $fn\n"; - return OK; + $errtext.=&mt("
Invalid map: [_1]",$fn); + return; } my $instr=&Apache::lonnet::getfile($fn); @@ -164,7 +170,9 @@ sub loadmap { if ($token->[2]->{'external'} eq 'true') { # external $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; } elsif ($turi=~/^\/*uploaded\//) { # uploaded - if (($embstyle eq 'img') || ($embstyle eq 'emb')) { + if (($embstyle eq 'img') + || ($embstyle eq 'emb') + || ($embstyle eq 'wrp')) { $turi='/adm/wrapper'.$turi; } elsif ($embstyle eq 'ssi') { #do nothing with these @@ -175,7 +183,9 @@ sub loadmap { my $mapdir=$uri; $mapdir=~s/[^\/]+$//; $turi=&Apache::lonnet::hreflocation($mapdir,$turi); - if (($embstyle eq 'img') || ($embstyle eq 'emb')) { + if (($embstyle eq 'img') + || ($embstyle eq 'emb') + || ($embstyle eq 'wrp')) { $turi='/adm/wrapper'.$turi; } } @@ -273,9 +283,9 @@ sub loadmap { } $name=~s/^.*_([^_]*)$/$1/; my $newparam= - &Apache::lonnet::escape($token->[2]->{'type'}).':'. - &Apache::lonnet::escape($part.'.'.$name).'='. - &Apache::lonnet::escape($token->[2]->{'value'}); + &escape($token->[2]->{'type'}).':'. + &escape($part.'.'.$name).'='. + &escape($token->[2]->{'value'}); if (defined($hash{'param_'.$referid})) { $hash{'param_'.$referid}.='&'.$newparam; } else { @@ -306,7 +316,7 @@ sub loadmap { } } else { - $errtext.='Map not loaded: The file ('.$fn.') does not exist. '; + $errtext.=&mt('
Map not loaded: The file [_1] does not exist.',$fn); } } @@ -314,20 +324,22 @@ sub loadmap { sub simplify { 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; + 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; + s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g; return $expression; } @@ -362,7 +374,11 @@ sub traceroute { } else { $hash{'conditions_'.$rid}=$sofar; } - $newsofar=$hash{'conditions_'.$rid}; + + # if the expression is just the 0th condition keep it + # otherwise leave a pointer to this condition expression + $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid; + if (defined($hash{'is_map_'.$rid})) { if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { $sofar=$newsofar= @@ -373,18 +389,17 @@ sub traceroute { } } if (defined($hash{'to_'.$rid})) { - foreach (split(/\,/,$hash{'to_'.$rid})) { + foreach my $id (split(/\,/,$hash{'to_'.$rid})) { my $further=$sofar; - if ($hash{'undercond_'.$_}) { - if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) { - $further=simplify('('.$further.')&('. - $hash{'condid_'.$hash{'undercond_'.$_}}.')'); + if ($hash{'undercond_'.$id}) { + if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) { + $further=simplify('('.'_'.$rid.')&('. + $hash{'condid_'.$hash{'undercond_'.$id}}.')'); } else { - $errtext.='Undefined condition ID: ' - .$hash{'undercond_'.$_}.'. '; + $errtext.=&mt('
Undefined condition ID: [_1]',$hash{'undercond_'.$id}); } } - $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere, + $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, $encflag,$hdnflag); } } @@ -400,51 +415,47 @@ sub accinit { my %captured=(); 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; + foreach my $key (keys(%hash)) { + if ($key=~/^conditions/) { + my $expr=$hash{$key}; + # try to find and factor out common sub-expressions + foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) { + my $orig=$sub; + + my ($factor) = ($sub=~/\(\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+\)(?:\|\(\1(?:[_\.\d]+\&*)+\))+\)/); + next if (!defined($factor)); + + $sub=~s/\Q$factor\E//g; $sub=~s/^\(/\($factor\(/; $sub.=')'; $sub=simplify($sub); - $orig=~s/(\W)/\\$1/g; - $expr=~s/$orig/$sub/; + $expr=~s/\Q$orig\E/$sub/; } - $hash{$_}=$expr; + $hash{$key}=$expr; unless (defined($captured{$expr})) { $condcounter++; $captured{$expr}=$condcounter; $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; } - } elsif ($_=~/^param_(\d+)\.(\d+)/) { + } elsif ($key=~/^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(/\=/,$_); + foreach my $param (split(/\&/,$hash{$key})) { + my ($typename,$value)=split(/\=/,$param); 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); + $parmhash{$prefix.'.'.&unescape($name)}= + &unescape($value); + $parmhash{$prefix.'.'.&unescape($name).'.type'}= + &unescape($type); } } } - foreach (keys %hash) { - if ($_=~/^ids/) { - foreach (split(/\,/,$hash{$_})) { - my $resid=$_; + foreach my $key (keys(%hash)) { + if ($key=~/^ids/) { + foreach my $resid (split(/\,/,$hash{$key})) { 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); + my ($uripath,$urifile) = + &Apache::lonnet::split_uri_for_cond($uri); if ($uripath) { my $uricond='0'; if (defined($hash{'conditions_'.$resid})) { @@ -456,8 +467,8 @@ sub accinit { my $replace=$1; my $regexp=$replace; #$regexp=~s/\|/\\\|/g; - $acchash{'acc.res.'.$short.'.'.$uripath} - =~s/\Q$regexp\E/$replace\|$uricond/; + $acchash{'acc.res.'.$short.'.'.$uripath} =~ + s/\Q$regexp\E/$replace\|$uricond/; } else { $acchash{'acc.res.'.$short.'.'.$uripath}.= $urifile.':'.$uricond.'&'; @@ -486,8 +497,8 @@ sub hiddenurls { my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; # ------------------------------------------- put existing resources into array my @currentrids=(); - foreach (sort(keys(%hash))) { - if ($_=~/^src_($mpc\.\d+)/) { + foreach my $key (sort(keys(%hash))) { + if ($key=~/^src_($mpc\.\d+)/) { if ($hash{'src_'.$1}) { push @currentrids, $1; } } } @@ -539,25 +550,31 @@ sub hiddenurls { sub readmap { my $short=shift; $short=~s/^\///; - my %cenv=&Apache::lonnet::coursedescription($short); + my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); 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.'; + return ('',&mt('No course data available.'));; } @cond=('true:normal'); - #unlink($fn.'.db'); - #unlink($fn.'_symb.db'); - unlink($fn.'.state'); - unlink($fn.'parms.db'); + + 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 ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && + if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { %hash=(); %parmhash=(); @@ -579,15 +596,19 @@ sub readmap { &hiddenurls(); } # ------------------------------------------------------- Put versions into src - foreach (keys %hash) { - if ($_=~/^src\_/) { - $hash{$_}=&putinversion($hash{$_}); + foreach my $key (keys(%hash)) { + if ($key=~/^src_/) { + $hash{$key}=&putinversion($hash{$key}); + } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { + my ($type, $url) = ($1,$2); + my $value = $hash{$key}; + $hash{$type.&putinversion($url)}=$value; } } # ---------------------------------------------------------------- Encrypt URLs - foreach (keys %encurl) { -# $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_}); - $hash{'encrypted_'.$_}=1; + foreach my $id (keys(%encurl)) { +# $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id}); + $hash{'encrypted_'.$id}=1; } # ----------------------------------------------- Close hashes to finally store # --------------------------------- Routine must pass this point, no early outs @@ -605,13 +626,19 @@ sub readmap { &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: ". @@ -620,7 +647,8 @@ sub readmap { while($i<90) { $i++; sleep(1); - if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) { + 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, @@ -634,6 +662,8 @@ sub readmap { untie(%hash); untie(%parmhash); } + flock(LOCKFILE,LOCK_UN); + close(LOCKFILE); } &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext); # ------------------------------------------------- Check for critical messages @@ -656,7 +686,7 @@ sub evalstate { if (-e $fn) { my @conditions=(); { - my $fh=Apache::File->new($fn); + open(my $fh,$fn); @conditions=<$fh>; } my $safeeval = new Safe;