--- rat/lonuserstate.pm	2005/06/08 18:49:38	1.92
+++ rat/lonuserstate.pm	2006/02/23 18:17:37	1.105
@@ -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.92 2005/06/08 18:49:38 www Exp $
+# $Id: lonuserstate.pm,v 1.105 2006/02/23 18:17:37 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,7 +31,6 @@ package Apache::lonuserstate;
 
 # ------------------------------------------------- modules used by this module
 use strict;
-use Apache::Constants qw(:common :http);
 use HTML::TokeParser;
 use Apache::lonnet;
 use Apache::loncommon();
@@ -41,6 +40,7 @@ use Safe;
 use Safe::Hole;
 use Opcode;
 use Apache::lonenc;
+use Fcntl qw(:flock);
 
 # ---------------------------------------------------- Globals for this package
 
@@ -73,6 +73,7 @@ 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; }
@@ -81,6 +82,7 @@ sub putinversion {
 	             { return $uri; }
 	$uri=~s/\.(\w+)$/\.$version\.$1/;
     }
+    &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
     return $uri;
 }
 
@@ -101,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;
@@ -116,7 +118,7 @@ sub loadmap {
     unless (($fn=~/\.sequence$/) ||
             ($fn=~/\.page$/)) { 
 	$errtext.="Invalid map: $fn\n";
-	return OK; 
+	return; 
     }
 
     my $instr=&Apache::lonnet::getfile($fn);
@@ -126,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;
@@ -161,7 +164,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
@@ -172,7 +177,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;
 			    }
                         }
@@ -311,20 +318,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;
 }
 
@@ -359,7 +368,7 @@ sub traceroute {
 	} else {
 	    $hash{'conditions_'.$rid}=$sofar;
 	}
-	$newsofar=$hash{'conditions_'.$rid};
+	$newsofar='_'.$rid;
 	if (defined($hash{'is_map_'.$rid})) {
 	    if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
 		$sofar=$newsofar=
@@ -374,7 +383,7 @@ sub traceroute {
 		my $further=$sofar;
                 if ($hash{'undercond_'.$_}) {
 		    if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
-			$further=simplify('('.$further.')&('.
+			$further=simplify('('.'_'.$rid.')&('.
 					  $hash{'condid_'.$hash{'undercond_'.$_}}.')');
 		    } else {
 			$errtext.='Undefined condition ID: '
@@ -397,13 +406,12 @@ 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+\&*)+\))+\)/;
+    foreach my $key (keys(%hash)) {
+	if ($key=~/^conditions/) {
+	    my $expr=$hash{$key};
+	    foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) {
+		my $orig=$sub;
+		$sub=~/\(\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+\)(?:\|\(\1(?:[_\.\d]+\&*)+\))+\)/;
 		my $factor=$1;
 		$sub=~s/$factor//g;
 		$sub=~s/^\(/\($factor\(/;
@@ -412,17 +420,17 @@ sub accinit {
 		$orig=~s/(\W)/\\$1/g;
 		$expr=~s/$orig/$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);
@@ -431,17 +439,12 @@ sub accinit {
 	    }
 	}
     }
-    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})) {
@@ -453,8 +456,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.'&';
@@ -546,15 +549,21 @@ sub readmap {
 	return '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=();
@@ -588,6 +597,7 @@ sub readmap {
 	}
 # ----------------------------------------------- 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("<font color=blue>WARNING: ".
 				     "Could not untie coursemap $fn for $uri.</font>"); 
@@ -601,13 +611,19 @@ sub readmap {
 		&Apache::lonnet::logthis("<font color=blue>WARNING: ".
 					 "Could not write statemap $fn for $uri.</font>"); 
 	    }
-	}  
+	}
+	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("<font color=blue>WARNING: ".
@@ -616,7 +632,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,
@@ -630,6 +647,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
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>