version 1.3, 2000/08/06 03:25:24
|
version 1.17, 2000/11/02 17:46:43
|
Line 10
|
Line 10
|
# 7/1 Gerd Kortemeyer) |
# 7/1 Gerd Kortemeyer) |
# 7/1,7/3,7/4,7/7,7/8,7/10 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 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 Gerd Kortemeyer |
|
|
package Apache::lonuserstate; |
package Apache::lonuserstate; |
|
|
Line 20 use Apache::File;
|
Line 21 use Apache::File;
|
use HTML::TokeParser; |
use HTML::TokeParser; |
use Apache::lonnet(); |
use Apache::lonnet(); |
use GDBM_File; |
use GDBM_File; |
|
use Apache::lonmsg; |
|
use Safe; |
|
use Opcode; |
|
|
# ---------------------------------------------------- Globals for this package |
# ---------------------------------------------------- Globals for this package |
|
|
Line 41 sub loadmap {
|
Line 45 sub loadmap {
|
|
|
my $fn='/home/httpd/html'.$uri; |
my $fn='/home/httpd/html'.$uri; |
|
|
unless (($fn=~/\.course$/) || |
unless (($fn=~/\.sequence$/) || |
($fn=~/\.sequence$/) || |
|
($fn=~/\.page$/)) { |
($fn=~/\.page$/)) { |
$errtext.="Invalid map: $fn\n"; |
$errtext.="Invalid map: $fn\n"; |
return OK; |
return OK; |
Line 116 sub loadmap {
|
Line 119 sub loadmap {
|
$hash{'type_'.$rid}='normal'; |
$hash{'type_'.$rid}='normal'; |
} |
} |
|
|
if (($turi=~/\.course$/) || |
if (($turi=~/\.sequence$/) || |
($turi=~/\.sequence$/) || |
|
($turi=~/\.page$/)) { |
($turi=~/\.page$/)) { |
$hash{'is_map_'.$rid}=1; |
$hash{'is_map_'.$rid}=1; |
&loadmap($turi); |
&loadmap($turi); |
Line 179 sub loadmap {
|
Line 181 sub loadmap {
|
|
|
sub simplify { |
sub simplify { |
my $expression=shift; |
my $expression=shift; |
# "True and" is nothing |
|
$expression=~s/0\&//g; |
|
# (8)=8 |
# (8)=8 |
$expression=~s/\((\d+)\)/$1/g; |
$expression=~s/\((\d+)\)/$1/g; |
# 8&8=8 |
# 8&8=8 |
$expression=~s/(\d+)\&\1/$1/g; |
$expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; |
# 8|8=8 |
# 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 |
# (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)) |
# (((5&3)|(4&6)))=((5&3)|(4&6)) |
$expression=~ |
$expression=~ |
s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; |
s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; |
Line 238 sub traceroute {
|
Line 238 sub traceroute {
|
} |
} |
} |
} |
|
|
|
# ------------------------------------------ Cascading conditions, quick access |
|
|
|
sub accinit { |
|
my ($uri,$short,$fn)=@_; |
|
my %acchash=(); |
|
my %captured=(); |
|
my $condcounter=0; |
|
$acchash{'acc.cond.'.$short.'.0'}=0; |
|
map { |
|
if ($_=~/^conditions/) { |
|
my $expr=$hash{$_}; |
|
map { |
|
my $sub=$_; |
|
my $orig=$_; |
|
$sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; |
|
my $factor=$1; |
|
$sub=~s/$factor//g; |
|
$sub=~s/^\(/\($factor\(/; |
|
$sub.=')'; |
|
$sub=simplify($sub); |
|
$orig=~s/(\W)/\\$1/g; |
|
$expr=~s/$orig/$sub/; |
|
} ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g); |
|
$hash{$_}=$expr; |
|
unless (defined($captured{$expr})) { |
|
$condcounter++; |
|
$captured{$expr}=$condcounter; |
|
$acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; |
|
} |
|
} |
|
} keys %hash; |
|
map { |
|
if ($_=~/^ids/) { |
|
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})) { |
|
$uricond=$captured{$hash{'conditions_'.$resid}}; |
|
} |
|
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.'.$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.id" => $short, |
|
"request.course.fn" => $fn, |
|
"request.course.uri" => $courseuri); |
|
} |
|
|
# ---------------------------------------------------- Read map and all submaps |
# ---------------------------------------------------- Read map and all submaps |
|
|
sub readmap { |
sub readmap { |
my $uri=shift; |
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("<font color=blue>WARNING: ". |
|
"Could not load course $short.</font>"); |
|
return 'No course data available.'; |
|
} |
@cond=('true:normal'); |
@cond=('true:normal'); |
%hash=(); |
unlink($fn.'.db'); |
$errtext=''; |
unlink($fn.'_symb.db'); |
$pc=0; |
unlink($fn.'.state'); |
loadmap($uri); |
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) { |
if (defined($hash{'map_start_'.$uri})) { |
%hash=(); |
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
$errtext=''; |
|
$pc=0; |
|
loadmap($uri); |
|
if (defined($hash{'map_start_'.$uri})) { |
|
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
|
&accinit($uri,$short,$fn); |
|
} |
|
unless (untie(%hash)) { |
|
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not untie coursemap $fn for $uri.</font>"); |
|
} |
|
{ |
|
my $cfh; |
|
if ($cfh=Apache::File->new(">$fn.state")) { |
|
print $cfh join("\n",@cond); |
|
} else { |
|
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not write statemap $fn for $uri.</font>"); |
|
} |
|
} |
|
} else { |
|
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not tie coursemap $fn for $uri.</font>"); |
} |
} |
|
&Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); |
|
return $errtext; |
} |
} |
|
|
# ---------------------------------------------------------------- Testing only |
# ------------------------------------------------------- Evaluate state string |
|
|
sub handler { |
sub evalstate { |
my $r = shift; |
my $safeeval = new Safe; |
$r->content_type('text/html'); |
my $fn=$ENV{'request.course.fn'}.'.state'; |
$r->send_http_header; |
my $state='2'; |
return OK if $r->header_only; |
if (-e $fn) { |
readmap('/res/msu/korte/foo.course'); |
my @conditions=(); |
$r->print("<html><body>\n"); |
{ |
my $hashkey; |
my $fh=Apache::File->new($fn); |
foreach $hashkey (sort keys %hash) { |
@conditions=<$fh>; |
$r->print("$hashkey: $hash{$hashkey}<br>\n"); |
} |
} |
$safeeval->permit("entereval"); |
my $i; |
$safeeval->permit(":base_math"); |
$r->print('<hr>'); |
$safeeval->deny(":base_io"); |
for ($i=0;$i<=$#cond;$i++) { |
$safeeval->share_from('Apache::lonnet',['&EXT']); |
$r->print($i.' : '.$cond[$i]."<br>\n"); |
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; |
} |
} |
$r->print("<h1>$errtext</h1></body></html>\n"); |
&Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state); |
return OK; |
return $state; |
} |
} |
|
|
|
|
|
|
1; |
1; |
__END__ |
__END__ |
|
|