--- rat/lonuserstate.pm 2000/08/22 15:26:28 1.4 +++ rat/lonuserstate.pm 2000/12/28 21:42:28 1.21 @@ -10,7 +10,9 @@ # 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 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 Gerd Kortemeyer package Apache::lonuserstate; @@ -20,13 +22,19 @@ use Apache::File; use HTML::TokeParser; use Apache::lonnet(); use GDBM_File; +use Apache::lonmsg; +use Safe; +use Safe::Hole; +use Opcode; # ---------------------------------------------------- Globals for this package my $pc; # Package counter my %hash; # The big tied hash +my %parmhash;# The hash with the parameters my @cond; # Array with all of the conditions my $errtext; # variable with all errors +my $retfurl; # variable with the very first URL in the course # --------------------------------------------------------- Loads map from disk @@ -41,8 +49,7 @@ sub loadmap { my $fn='/home/httpd/html'.$uri; - unless (($fn=~/\.course$/) || - ($fn=~/\.sequence$/) || + unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { $errtext.="Invalid map: $fn\n"; return OK; @@ -116,8 +123,7 @@ sub loadmap { $hash{'type_'.$rid}='normal'; } - if (($turi=~/\.course$/) || - ($turi=~/\.sequence$/) || + if (($turi=~/\.sequence$/) || ($turi=~/\.page$/)) { $hash{'is_map_'.$rid}=1; &loadmap($turi); @@ -165,6 +171,23 @@ sub loadmap { } else { $hash{'from_'.$goesto}=''.$linkid; } + } elsif ($token->[1] eq 'param') { +# ------------------------------------------------------------------- Parameter + + my $referid=$lpc.'.'.$token->[2]->{'to'}; + my $part=$token->[2]->{'part'}; + unless ($part) { $part=0; } + my $newparam= + &Apache::lonnet::escape($token->[2]->{'type'}).':'. + &Apache::lonnet::escape($part.'.'. + $token->[2]->{'name'}).'='. + &Apache::lonnet::escape($token->[2]->{'value'}); + if (defined($hash{'param_'.$referid})) { + $hash{'param_'.$referid}.='&'.$newparam; + } else { + $hash{'param_'.$referid}=''.$newparam; + } + } } @@ -179,16 +202,14 @@ sub loadmap { sub simplify { my $expression=shift; -# "True and" is nothing - $expression=~s/0\&//g; # (8)=8 $expression=~s/\((\d+)\)/$1/g; # 8&8=8 - $expression=~s/(\d+)\&\1/$1/g; + $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; # 8|8=8 - $expression=~s/(\d+)\|\1/$1/g; + $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g; # (5&3)&4=5&3&4 - $expression=~s/\((\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; @@ -205,6 +226,9 @@ sub traceroute { $sofar=simplify($sofar); unless ($beenhere=~/\&$rid\&/) { $beenhere.=$rid.'&'; + if ($retfurl eq '') { + $retfurl=$hash{'src_'.$rid}; + } if (defined($hash{'conditions_'.$rid})) { $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); @@ -238,74 +262,112 @@ sub traceroute { } } -# ------------------------------------------ Cascading conditions, quick access +# ------------------------------ Cascading conditions, quick access, parameters sub accinit { my ($uri,$short,$fn)=@_; my %acchash=(); my %captured=(); my $condcounter=0; - $acchash{'acc.cond.0'}='0'; + $acchash{'acc.cond.'.$short.'.0'}=0; map { if ($_=~/^conditions/) { my $expr=$hash{$_}; map { my $sub=$_; my $orig=$_; - $sub=~/\(\((\d+(:?\&\d+)*)(?:\&\d+)+\)(?:\|\(\1(?:\&\d+)+\))+\)/; + $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; my $factor=$1; - $sub=~s/$factor\&//g; - $sub=~s/^\(/\($factor\&\(/; + $sub=~s/$factor//g; + $sub=~s/^\(/\($factor\(/; $sub.=')'; $sub=simplify($sub); $orig=~s/(\W)/\\$1/g; - $expr=~s/$orig/$sub/; + $expr=~s/$orig/$sub/; } ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g); $hash{$_}=$expr; unless (defined($captured{$expr})) { $condcounter++; $captured{$expr}=$condcounter; - $acchash{'acc.cond.'.$condcounter}=$expr; + $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}); + map { + 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); + } split(/\&/,$hash{$_}); + } } keys %hash; map { if ($_=~/^ids/) { - my $resid=$hash{$_}; + map { + my $resid=$_; my $uri=$hash{'src_'.$resid}; my @uriparts=split(/\//,$uri); my $urifile=$uriparts[$#uriparts]; $#uriparts--; my $uripath=join('/',@uriparts); + $uripath=~s/^\/res\///; + my $uricond='0'; if (defined($hash{'conditions_'.$resid})) { - $urifile.=':'.$captured{$hash{'conditions_'.$resid}}; - } else { - $urifile.=':0'; + $uricond=$captured{$hash{'conditions_'.$resid}}; } - if (defined($acchash{'acc.res.'.$uripath})) { - $acchash{'acc.res.'.$uripath}.=$urifile.'&'; + if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { + if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ + /(\&$urifile\:[^\&]*)/) { + my $replace=$1; + $acchash{'acc.res.'.$short.'.'.$uripath} + =~s/$replace/$replace\|$uricond/; + } else { + $acchash{'acc.res.'.$short.'.'.$uripath}.= + $urifile.':'.$uricond.'&'; + } } else { - $acchash{'acc.res.'.$uripath}='&'.$urifile.'&'; - } - } + $acchash{'acc.res.'.$short.'.'.$uripath}= + '&'.$urifile.':'.$uricond.'&'; + } + } split(/\,/,$hash{$_}); + } } keys %hash; + my $courseuri=$uri; + $courseuri=~s/^\/res\///; + &Apache::lonnet::delenv('(acc\.|httpref\.)'); &Apache::lonnet::appenv(%acchash, - "request.course" => $short, - "request.course.fn" => $fn); + "request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $courseuri); } # ---------------------------------------------------- Read map and all submaps -# -# Call with uri of course map, short name for course, and filename for -# binary structure -# - sub readmap { - my ($uri,$short,$fn)=@_; + 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'); - if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) { + unlink($fn.'.db'); + unlink($fn.'_symb.db'); + unlink($fn.'.state'); + unlink($fn.'parms.db'); + $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; loadmap($uri); @@ -313,7 +375,7 @@ sub readmap { &traceroute('0',$hash{'map_start_'.$uri},'&'); &accinit($uri,$short,$fn); } - unless (untie(%hash)) { + unless ((untie(%hash)) && (untie(%parmhash))) { &Apache::lonnet::logthis("WARNING: ". "Could not untie coursemap $fn for $uri."); } @@ -322,17 +384,59 @@ sub readmap { if ($cfh=Apache::File->new(">$fn.state")) { print $cfh join("\n",@cond); } else { - &Apache::lonnet::logthis("WARNING: ". + &Apache::lonnet::logthis("WARNING: ". "Could not write statemap $fn for $uri."); } } } else { - &Apache::lonnet::logthis("WARNING: ". + &Apache::lonnet::logthis("WARNING: ". "Could not tie coursemap $fn for $uri."); } - return $errtext; + &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); + return ($retfurl,$errtext); +} + +# ------------------------------------------------------- Evaluate state string + +sub evalstate { + + my $fn=$ENV{'request.course.fn'}.'.state'; + my $state='2'; + 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'); + map { + 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'; + } + } + } @conditions; + } + &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state); + return $state; } - + 1; __END__ 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.