version 1.15, 2000/11/01 22:21:36
|
version 1.24, 2001/08/31 14:19:06
|
Line 11
|
Line 11
|
# 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,8/21,8/22,8/23,8/30, |
# 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 Gerd Kortemeyer |
# 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, |
|
# 07/05/01,08/30,08/31 Gerd Kortemeyer |
|
|
package Apache::lonuserstate; |
package Apache::lonuserstate; |
|
|
Line 23 use Apache::lonnet();
|
Line 25 use Apache::lonnet();
|
use GDBM_File; |
use GDBM_File; |
use Apache::lonmsg; |
use Apache::lonmsg; |
use Safe; |
use Safe; |
|
use Safe::Hole; |
use Opcode; |
use Opcode; |
|
|
|
|
# ---------------------------------------------------- Globals for this package |
# ---------------------------------------------------- Globals for this package |
|
|
my $pc; # Package counter |
my $pc; # Package counter |
my %hash; # The big tied hash |
my %hash; # The big tied hash |
|
my %parmhash;# The hash with the parameters |
my @cond; # Array with all of the conditions |
my @cond; # Array with all of the conditions |
my $errtext; # variable with all errors |
my $errtext; # variable with all errors |
|
my $retfurl; # variable with the very first URL in the course |
|
|
# --------------------------------------------------------- Loads map from disk |
# --------------------------------------------------------- Loads map from disk |
|
|
Line 52 sub loadmap {
|
Line 56 sub loadmap {
|
return OK; |
return OK; |
} |
} |
|
|
|
my $ispage=($fn=~/\.page$/); |
|
|
unless (-e $fn) { |
unless (-e $fn) { |
my $returned=Apache::lonnet::repcopy($fn); |
my $returned=Apache::lonnet::repcopy($fn); |
unless ($returned eq OK) { |
unless ($returned eq OK) { |
Line 95 sub loadmap {
|
Line 101 sub loadmap {
|
$hash{'kind_'.$rid}='res'; |
$hash{'kind_'.$rid}='res'; |
$hash{'title_'.$rid}=$token->[2]->{'title'}; |
$hash{'title_'.$rid}=$token->[2]->{'title'}; |
my $turi=$token->[2]->{'src'}; |
my $turi=$token->[2]->{'src'}; |
|
unless ($ispage) { |
|
$turi=~/\.(\w+)$/; |
|
my $embstyle=&Apache::lonnet::fileembstyle($1); |
|
if ($token->[2]->{'external'} eq 'true') { |
|
$turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; |
|
} else { |
|
my $embstyle=&Apache::lonnet::fileembstyle($1); |
|
if (($embstyle eq 'img') || ($embstyle eq 'emb')) { |
|
$turi='/adm/wrapper'.$turi; |
|
} |
|
} |
|
} |
$hash{'src_'.$rid}=$turi; |
$hash{'src_'.$rid}=$turi; |
|
|
if (defined($hash{'ids_'.$turi})) { |
if (defined($hash{'ids_'.$turi})) { |
Line 103 sub loadmap {
|
Line 121 sub loadmap {
|
$hash{'ids_'.$turi}=''.$rid; |
$hash{'ids_'.$turi}=''.$rid; |
} |
} |
|
|
if ($token->[2]->{'src'}=~/\/\//) { |
if ($token->[2]->{'external'} eq 'true') { |
$hash{'ext_'.$rid}='true:'; |
$hash{'ext_'.$rid}='true:'; |
} else { |
} else { |
$hash{'ext_'.$rid}='false:'; |
$hash{'ext_'.$rid}='false:'; |
Line 168 sub loadmap {
|
Line 186 sub loadmap {
|
} else { |
} else { |
$hash{'from_'.$goesto}=''.$linkid; |
$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; |
|
} |
|
|
} |
} |
|
|
} |
} |
Line 206 sub traceroute {
|
Line 241 sub traceroute {
|
$sofar=simplify($sofar); |
$sofar=simplify($sofar); |
unless ($beenhere=~/\&$rid\&/) { |
unless ($beenhere=~/\&$rid\&/) { |
$beenhere.=$rid.'&'; |
$beenhere.=$rid.'&'; |
|
if ($retfurl eq '') { |
|
$retfurl=$hash{'src_'.$rid}; |
|
} |
if (defined($hash{'conditions_'.$rid})) { |
if (defined($hash{'conditions_'.$rid})) { |
$hash{'conditions_'.$rid}=simplify( |
$hash{'conditions_'.$rid}=simplify( |
'('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); |
'('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); |
Line 239 sub traceroute {
|
Line 277 sub traceroute {
|
} |
} |
} |
} |
|
|
# ------------------------------------------ Cascading conditions, quick access |
# ------------------------------ Cascading conditions, quick access, parameters |
|
|
sub accinit { |
sub accinit { |
my ($uri,$short,$fn)=@_; |
my ($uri,$short,$fn)=@_; |
Line 268 sub accinit {
|
Line 306 sub accinit {
|
$captured{$expr}=$condcounter; |
$captured{$expr}=$condcounter; |
$acchash{'acc.cond.'.$short.'.'.$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; |
} keys %hash; |
map { |
map { |
if ($_=~/^ids/) { |
if ($_=~/^ids/) { |
map { |
map { |
my $resid=$_; |
my $resid=$_; |
my $uri=$hash{'src_'.$resid}; |
my $uri=$hash{'src_'.$resid}; |
|
$uri=~s/^\/adm\/wrapper//; |
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
my $urifile=$uriparts[$#uriparts]; |
my $urifile=$uriparts[$#uriparts]; |
$#uriparts--; |
$#uriparts--; |
my $uripath=join('/',@uriparts); |
my $uripath=join('/',@uriparts); |
$uripath=~s/^\/res\///; |
$uripath=~s/^\/res\///; |
|
if ($uripath) { |
my $uricond='0'; |
my $uricond='0'; |
if (defined($hash{'conditions_'.$resid})) { |
if (defined($hash{'conditions_'.$resid})) { |
$uricond=$captured{$hash{'conditions_'.$resid}}; |
$uricond=$captured{$hash{'conditions_'.$resid}}; |
Line 297 sub accinit {
|
Line 348 sub accinit {
|
} else { |
} else { |
$acchash{'acc.res.'.$short.'.'.$uripath}= |
$acchash{'acc.res.'.$short.'.'.$uripath}= |
'&'.$urifile.':'.$uricond.'&'; |
'&'.$urifile.':'.$uricond.'&'; |
} |
} |
|
} |
} split(/\,/,$hash{$_}); |
} split(/\,/,$hash{$_}); |
} |
} |
} keys %hash; |
} keys %hash; |
|
$acchash{'acc.res.'.$short.'.'}='&:0&'; |
my $courseuri=$uri; |
my $courseuri=$uri; |
$courseuri=~s/^\/res\///; |
$courseuri=~s/^\/res\///; |
&Apache::lonnet::delenv('(acc\.|httpref\.)'); |
&Apache::lonnet::delenv('(acc\.|httpref\.)'); |
Line 328 sub readmap {
|
Line 381 sub readmap {
|
unlink($fn.'.db'); |
unlink($fn.'.db'); |
unlink($fn.'_symb.db'); |
unlink($fn.'_symb.db'); |
unlink($fn.'.state'); |
unlink($fn.'.state'); |
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) { |
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=(); |
%hash=(); |
|
%parmhash=(); |
$errtext=''; |
$errtext=''; |
$pc=0; |
$pc=0; |
loadmap($uri); |
loadmap($uri); |
Line 337 sub readmap {
|
Line 394 sub readmap {
|
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
&accinit($uri,$short,$fn); |
&accinit($uri,$short,$fn); |
} |
} |
unless (untie(%hash)) { |
unless ((untie(%hash)) && (untie(%parmhash))) { |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
"Could not untie coursemap $fn for $uri.</font>"); |
"Could not untie coursemap $fn for $uri.</font>"); |
} |
} |
Line 355 sub readmap {
|
Line 412 sub readmap {
|
"Could not tie coursemap $fn for $uri.</font>"); |
"Could not tie coursemap $fn for $uri.</font>"); |
} |
} |
&Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); |
&Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); |
&evalstate(); |
return ($retfurl,$errtext); |
return $errtext; |
|
} |
} |
|
|
# ------------------------------------------------------- Evaluate state string |
# ------------------------------------------------------- Evaluate state string |
|
|
sub evalstate { |
sub evalstate { |
my $safeeval = new Safe; |
|
my $fn=$ENV{'request.course.fn'}.'.state'; |
my $fn=$ENV{'request.course.fn'}.'.state'; |
my $state='2'; |
my $state='2'; |
if (-e $fn) { |
if (-e $fn) { |
Line 371 sub evalstate {
|
Line 427 sub evalstate {
|
my $fh=Apache::File->new($fn); |
my $fh=Apache::File->new($fn); |
@conditions=<$fh>; |
@conditions=<$fh>; |
} |
} |
|
my $safeeval = new Safe; |
|
my $safehole = new Safe::Hole; |
$safeeval->permit("entereval"); |
$safeeval->permit("entereval"); |
$safeeval->permit(":base_math"); |
$safeeval->permit(":base_math"); |
$safeeval->deny(":base_io"); |
$safeeval->deny(":base_io"); |
$safeeval->share_from('Apache::lonnet',['&varval']); |
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); |
map { |
map { |
my $line=$_; |
my $line=$_; |
chomp($line); |
chomp($line); |
my ($condition,$weight)=split(/\:/,$_); |
my ($condition,$weight)=split(/\:/,$_); |
$condition=~s/\&([\w\.]+)/\&varval\(\'$1\'\)/g; |
|
if ($safeeval->reval($condition)) { |
if ($safeeval->reval($condition)) { |
if ($weight eq 'force') { |
if ($weight eq 'force') { |
$state.='3'; |
$state.='3'; |