--- rat/lonuserstate.pm 2006/02/23 08:38:54 1.99.2.1 +++ rat/lonuserstate.pm 2006/05/05 15:50:20 1.109 @@ -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.99.2.1 2006/02/23 08:38:54 albertel Exp $ +# $Id: lonuserstate.pm,v 1.109 2006/05/05 15:50:20 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -93,9 +93,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}; } } @@ -319,21 +319,21 @@ sub loadmap { sub simplify { my $expression=shift; # (0&1) = 1 - $expression=~s/\(0\&(\d+)\)/$1/g; + $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; + s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g; return $expression; } @@ -368,7 +368,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= @@ -379,18 +383,18 @@ 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_'.$_}.'. '; + .$hash{'undercond_'.$id}.'. '; } } - $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere, + $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, $encflag,$hdnflag); } } @@ -406,32 +410,33 @@ 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); @@ -440,17 +445,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})) { @@ -462,8 +462,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.'&'; @@ -492,8 +492,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; } } } @@ -545,7 +545,7 @@ 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; @@ -591,15 +591,15 @@ 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}); } } # ---------------------------------------------------------------- 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