--- rat/lonuserstate.pm 2005/11/15 18:27:52 1.98
+++ rat/lonuserstate.pm 2006/05/25 21:09:45 1.113
@@ -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.98 2005/11/15 18:27:52 albertel Exp $
+# $Id: lonuserstate.pm,v 1.113 2006/05/25 21:09:45 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};
}
}
@@ -166,8 +166,7 @@ sub loadmap {
} elsif ($turi=~/^\/*uploaded\//) { # uploaded
if (($embstyle eq 'img')
|| ($embstyle eq 'emb')
- || ($embstyle eq 'ign')
- || ($embstyle eq 'unk')) {
+ || ($embstyle eq 'wrp')) {
$turi='/adm/wrapper'.$turi;
} elsif ($embstyle eq 'ssi') {
#do nothing with these
@@ -178,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;
}
}
@@ -317,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;
}
@@ -365,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=
@@ -376,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);
}
}
@@ -403,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);
@@ -437,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})) {
@@ -459,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.'&';
@@ -489,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; }
}
}
@@ -542,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;
@@ -588,15 +591,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
@@ -674,7 +681,7 @@ sub evalstate {
if (-e $fn) {
my @conditions=();
{
- my $fh=Apache::File->new($fn);
+ open(my $fh,$fn);
@conditions=<$fh>;
}
my $safeeval = new Safe;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
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.
More information about this error may be available
in the server error log.