--- rat/lonuserstate.pm 2003/11/01 16:42:13 1.67
+++ rat/lonuserstate.pm 2006/01/10 21:41:29 1.99
@@ -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.67 2003/11/01 16:42:13 www Exp $
+# $Id: lonuserstate.pm,v 1.99 2006/01/10 21:41:29 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -31,16 +31,16 @@ package Apache::lonuserstate;
# ------------------------------------------------- modules used by this module
use strict;
-use Apache::Constants qw(:common :http);
-use Apache::File;
use HTML::TokeParser;
-use Apache::lonnet();
+use Apache::lonnet;
use Apache::loncommon();
use GDBM_File;
use Apache::lonmsg;
use Safe;
use Safe::Hole;
use Opcode;
+use Apache::lonenc;
+use Fcntl qw(:flock);
# ---------------------------------------------------- Globals for this package
@@ -52,6 +52,8 @@ my $errtext; # variable with all errors
my $retfurl; # variable with the very first URL in the course
my %randompick; # randomly picked resources
my %randompickseed; # optional seed for randomly picking resources
+my %encurl; # URLs in this folder are supposed to be encrypted
+my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
# ----------------------------------- Remove version from URL and store in hash
@@ -71,6 +73,7 @@ sub versiontrack {
sub putinversion {
my $uri=shift;
+ my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri);
if ($hash{'version_'.$uri}) {
my $version=$hash{'version_'.$uri};
if ($version eq 'mostrecent') { return $uri; }
@@ -79,6 +82,7 @@ sub putinversion {
{ return $uri; }
$uri=~s/\.(\w+)$/\.$version\.$1/;
}
+ &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
return $uri;
}
@@ -99,7 +103,7 @@ sub processversionfile {
sub loadmap {
my $uri=shift;
- if ($hash{'map_pc_'.$uri}) { return OK; }
+ if ($hash{'map_pc_'.$uri}) { return; }
$pc++;
my $lpc=$pc;
@@ -113,8 +117,8 @@ sub loadmap {
unless (($fn=~/\.sequence$/) ||
($fn=~/\.page$/)) {
- $errtext.="Invalid map: $fn\n";
- return OK;
+ $errtext.="Invalid map: $fn\n";
+ return;
}
my $instr=&Apache::lonnet::getfile($fn);
@@ -124,6 +128,7 @@ sub loadmap {
# Successfully got file, parse it
my $parser = HTML::TokeParser->new(\$instr);
+ $parser->attr_encoded(1);
my $token;
my $linkpc=0;
@@ -136,7 +141,7 @@ sub loadmap {
if ($token->[0] eq 'S') {
if ($token->[1] eq 'resource') {
# -------------------------------------------------------------------- Resource
-
+ if ($token->[2]->{'type'} eq 'zombie') { next; }
my $rid=$lpc.'.'.$token->[2]->{'id'};
$hash{'kind_'.$rid}='res';
@@ -147,37 +152,48 @@ sub loadmap {
$hash{'version_'.$turi}=$1;
}
}
- &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache,
- &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'},
- $turi),
- $token->[2]->{'title'},'title');
+ my $title=$token->[2]->{'title'};
+ $title=~s/\&colon\;/\:/gs;
+# my $symb=&Apache::lonnet::encode_symb($uri,
+# $token->[2]->{'id'},
+# $turi);
+# &Apache::lonnet::do_cache_new('title',$symb,$title);
unless ($ispage) {
$turi=~/\.(\w+)$/;
my $embstyle=&Apache::loncommon::fileembstyle($1);
if ($token->[2]->{'external'} eq 'true') { # external
$turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
} elsif ($turi=~/^\/*uploaded\//) { # uploaded
- if (($embstyle eq 'img') || ($embstyle eq 'emb')
- || ($embstyle eq 'ssi')) {
+ if (($embstyle eq 'img')
+ || ($embstyle eq 'emb')
+ || ($embstyle eq 'wrp')) {
$turi='/adm/wrapper'.$turi;
- } elsif ($turi!~/\.(sequence|page)$/) {
+ } elsif ($embstyle eq 'ssi') {
+ #do nothing with these
+ } elsif ($turi!~/\.(sequence|page)$/) {
$turi='/adm/coursedocs/showdoc'.$turi;
}
- } else { # normal internal resource
- if (($embstyle eq 'img') || ($embstyle eq 'emb')) {
- $turi='/adm/wrapper'.$turi;
- }
+ } elsif ($turi=~/\S/) { # normal non-empty internal resource
+ my $mapdir=$uri;
+ $mapdir=~s/[^\/]+$//;
+ $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
+ if (($embstyle eq 'img')
+ || ($embstyle eq 'emb')
+ || ($embstyle eq 'wrp')) {
+ $turi='/adm/wrapper'.$turi;
+ }
}
}
-
- if (defined($hash{'ids_'.$turi})) {
- $hash{'ids_'.$turi}.=','.$rid;
+# Store reverse lookup, remove query string
+ my $idsuri=$turi;
+ $idsuri=~s/\?.+$//;
+ if (defined($hash{'ids_'.$idsuri})) {
+ $hash{'ids_'.$idsuri}.=','.$rid;
} else {
- $hash{'ids_'.$turi}=''.$rid;
+ $hash{'ids_'.$idsuri}=''.$rid;
}
- if
- ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
+ if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
$turi.='?register=1';
}
@@ -269,94 +285,115 @@ sub loadmap {
} else {
$hash{'param_'.$referid}=''.$newparam;
}
- if ($token->[2]->{'name'} eq 'parameter_mapalias') {
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
$hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
}
- if ($token->[2]->{'name'} eq 'parameter_randompick') {
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {
$randompick{$referid}=$token->[2]->{'value'};
}
- if ($token->[2]->{'name'} eq 'parameter_randompickseed') {
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {
$randompick{$referid}=$token->[2]->{'value'};
}
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
+ if ($token->[2]->{'value'}=~/^yes$/i) {
+ $encurl{$referid}=1;
+ }
+ }
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) {
+ if ($token->[2]->{'value'}=~/^yes$/i) {
+ $hiddenurl{$referid}=1;
+ }
+ }
}
-
+
}
}
} else {
- $errtext.='Map not loaded: The file does not exist. ';
+ $errtext.='Map not loaded: The file ('.$fn.') does not exist. ';
}
}
# --------------------------------------------------------- Simplify expression
sub simplify {
- my $expression=shift;
+ my $expression=shift;
# (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;
- return $expression;
+ $expression=~
+ s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
+ return $expression;
}
# -------------------------------------------------------- Build condition hash
sub traceroute {
- my ($sofar,$rid,$beenhere)=@_;
- $sofar=simplify($sofar);
+ my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
+ my $newsofar=$sofar=simplify($sofar);
unless ($beenhere=~/\&$rid\&/) {
- $beenhere.=$rid.'&';
- if (($retfurl eq '') && ($hash{'src_'.$rid})
- && ($hash{'src_'.$rid}!~/\.sequence$/)) {
- my ($mapid,$resid)=split(/\./,$rid);
- $retfurl=$hash{'src_'.$rid}.
- (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='.
- &Apache::lonnet::symbclean(
- &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
- '___'.$resid.'___'.
- &Apache::lonnet::declutter($hash{'src_'.$rid}));
- }
- if (defined($hash{'conditions_'.$rid})) {
- $hash{'conditions_'.$rid}=simplify(
+ $beenhere.=$rid.'&';
+ my ($mapid,$resid)=split(/\./,$rid);
+ my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
+ my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
+
+ if ($hdnflag || lc($hidden) eq 'yes') {
+ $hiddenurl{$rid}=1;
+ }
+ if (!$hdnflag && lc($hidden) eq 'no') {
+ delete($hiddenurl{$rid});
+ }
+
+ my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
+ if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
+ if (($retfurl eq '') && ($hash{'src_'.$rid})
+ && ($hash{'src_'.$rid}!~/\.sequence$/)) {
+ $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').
+ 'symb='.$symb;
+ }
+ if (defined($hash{'conditions_'.$rid})) {
+ $hash{'conditions_'.$rid}=simplify(
'('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
- } else {
- $hash{'conditions_'.$rid}=$sofar;
- }
- if (defined($hash{'is_map_'.$rid})) {
- if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
- &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
- if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
- $sofar=
- $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
- }
- }
- }
- if (defined($hash{'to_'.$rid})) {
- foreach (split(/\,/,$hash{'to_'.$rid})) {
+ } else {
+ $hash{'conditions_'.$rid}=$sofar;
+ }
+ $newsofar=$hash{'conditions_'.$rid};
+ if (defined($hash{'is_map_'.$rid})) {
+ if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
+ $sofar=$newsofar=
+ &traceroute($sofar,
+ $hash{'map_start_'.$hash{'src_'.$rid}},'&',
+ $encflag || $encurl{$rid},
+ $hdnflag || $hiddenurl{$rid});
+ }
+ }
+ if (defined($hash{'to_'.$rid})) {
+ foreach (split(/\,/,$hash{'to_'.$rid})) {
my $further=$sofar;
if ($hash{'undercond_'.$_}) {
- if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
- $further=simplify('('.$further.')&('.
- $hash{'condid_'.$hash{'undercond_'.$_}}.')');
- } else {
- $errtext.='Undefined condition ID: '
- .$hash{'undercond_'.$_}.'. ';
- }
+ if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
+ $further=simplify('('.$further.')&('.
+ $hash{'condid_'.$hash{'undercond_'.$_}}.')');
+ } else {
+ $errtext.='Undefined condition ID: '
+ .$hash{'undercond_'.$_}.'. ';
+ }
}
- &traceroute($further,$hash{'goesto_'.$_},$beenhere);
- }
- }
+ $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere,
+ $encflag,$hdnflag);
+ }
+ }
}
+ return $newsofar;
}
# ------------------------------ Cascading conditions, quick access, parameters
@@ -368,88 +405,85 @@ sub accinit {
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;
- $sub=~s/^\(/\($factor\(/;
- $sub.=')';
- $sub=simplify($sub);
- $orig=~s/(\W)/\\$1/g;
- $expr=~s/$orig/$sub/;
- }
- $hash{$_}=$expr;
- unless (defined($captured{$expr})) {
- $condcounter++;
- $captured{$expr}=$condcounter;
- $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});
- foreach (split(/\&/,$hash{$_})) {
- 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);
- }
- }
+ 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;
+ $sub=~s/^\(/\($factor\(/;
+ $sub.=')';
+ $sub=simplify($sub);
+ $orig=~s/(\W)/\\$1/g;
+ $expr=~s/$orig/$sub/;
+ }
+ $hash{$_}=$expr;
+ unless (defined($captured{$expr})) {
+ $condcounter++;
+ $captured{$expr}=$condcounter;
+ $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
+ }
+ } elsif ($_=~/^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(/\=/,$_);
+ 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);
+ }
+ }
}
foreach (keys %hash) {
if ($_=~/^ids/) {
- foreach (split(/\,/,$hash{$_})) {
- my $resid=$_;
- 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);
- if ($uripath) {
- 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}=~
- /(\&\Q$urifile\E\:[^\&]*)/) {
- my $replace=$1;
- my $regexp=$replace;
- $regexp=~s/\|/\\\|/g;
- $acchash{'acc.res.'.$short.'.'.$uripath}
- =~s/$regexp/$replace\|$uricond/;
- } else {
- $acchash{'acc.res.'.$short.'.'.$uripath}.=
- $urifile.':'.$uricond.'&';
- }
- } else {
- $acchash{'acc.res.'.$short.'.'.$uripath}=
- '&'.$urifile.':'.$uricond.'&';
- }
- }
- }
- }
+ foreach (split(/\,/,$hash{$_})) {
+ my $resid=$_;
+ 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);
+ if ($uripath) {
+ 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}=~
+ /(\&\Q$urifile\E\:[^\&]*)/) {
+ my $replace=$1;
+ my $regexp=$replace;
+ #$regexp=~s/\|/\\\|/g;
+ $acchash{'acc.res.'.$short.'.'.$uripath}
+ =~s/\Q$regexp\E/$replace\|$uricond/;
+ } else {
+ $acchash{'acc.res.'.$short.'.'.$uripath}.=
+ $urifile.':'.$uricond.'&';
+ }
+ } else {
+ $acchash{'acc.res.'.$short.'.'.$uripath}=
+ '&'.$urifile.':'.$uricond.'&';
+ }
+ }
+ }
+ }
}
$acchash{'acc.res.'.$short.'.'}='&:0&';
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);
+ &Apache::lonnet::appenv(%acchash);
}
-# ------------------------------------- Selectively delete from randompick maps
+# ---------------- Selectively delete from randompick maps and hidden url parms
-sub pickrandom {
+sub hiddenurls {
my $randomoutentry='';
foreach my $rid (keys %randompick) {
my $rndpick=$randompick{$rid};
@@ -483,14 +517,22 @@ sub pickrandom {
$hash{'randomout_'.$currentrids[$k]}=1;
my ($mapid,$resid)=split(/\./,$currentrids[$k]);
$randomoutentry.='&'.
- &Apache::lonnet::symbclean(
- &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
- '___'.$resid.'___'.
- &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})
- ).'&';
+ &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
+ $resid,
+ $hash{'src_'.$currentrids[$k]}
+ ).'&';
}
}
}
+# ------------------------------ take care of explicitly hidden urls or folders
+ foreach my $rid (keys %hiddenurl) {
+ $hash{'randomout_'.$rid}=1;
+ my ($mapid,$resid)=split(/\./,$rid);
+ $randomoutentry.='&'.
+ &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
+ $hash{'src_'.$rid}).'&';
+ }
+# --------------------------------------- append randomout entry to environment
if ($randomoutentry) {
&Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
}
@@ -499,116 +541,168 @@ sub pickrandom {
# ---------------------------------------------------- Read map and all submaps
sub readmap {
- 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');
- unlink($fn.'.db');
- unlink($fn.'_symb.db');
- unlink($fn.'.state');
- unlink($fn.'parms.db');
- undef %randompick;
- $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;
- &processversionfile(%cenv);
- my $furi=&Apache::lonnet::clutter($uri);
- $hash{'src_0.0'}=&versiontrack($furi);
- $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
- $hash{'ids_'.$furi}='0.0';
- $hash{'is_map_0.0'}=1;
- loadmap($uri);
- if (defined($hash{'map_start_'.$uri})) {
- &traceroute('0',$hash{'map_start_'.$uri},'&');
- &accinit($uri,$short,$fn);
- &pickrandom();
- }
+ 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');
+
+ open(LOCKFILE,">$fn.db.lock");
+ my $lock=0;
+ if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
+ $lock=1;
+ unlink($fn.'.db');
+ unlink($fn.'_symb.db');
+ unlink($fn.'.state');
+ unlink($fn.'parms.db');
+ }
+ undef %randompick;
+ undef %hiddenurl;
+ undef %encurl;
+ $retfurl='';
+ if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
+ (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
+ %hash=();
+ %parmhash=();
+ $errtext='';
+ $pc=0;
+ &processversionfile(%cenv);
+ my $furi=&Apache::lonnet::clutter($uri);
+ $hash{'src_0.0'}=&versiontrack($furi);
+ $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
+ $hash{'ids_'.$furi}='0.0';
+ $hash{'is_map_0.0'}=1;
+ loadmap($uri);
+ if (defined($hash{'map_start_'.$uri})) {
+ &Apache::lonnet::appenv("request.course.id" => $short,
+ "request.course.fn" => $fn,
+ "request.course.uri" => $uri);
+ &traceroute('0',$hash{'map_start_'.$uri},'&');
+ &accinit($uri,$short,$fn);
+ &hiddenurls();
+ }
# ------------------------------------------------------- Put versions into src
- foreach (keys %hash) {
- if ($_=~/^src\_/) {
- $hash{$_}=&putinversion($hash{$_});
+ foreach (keys %hash) {
+ if ($_=~/^src\_/) {
+ $hash{$_}=&putinversion($hash{$_});
+ }
+ }
+# ---------------------------------------------------------------- Encrypt URLs
+ foreach (keys %encurl) {
+# $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_});
+ $hash{'encrypted_'.$_}=1;
+ }
+# ----------------------------------------------- Close hashes to finally store
+# --------------------------------- Routine must pass this point, no early outs
+ $hash{'first_url'}=$retfurl;
+ unless ((untie(%hash)) && (untie(%parmhash))) {
+ &Apache::lonnet::logthis("WARNING: ".
+ "Could not untie coursemap $fn for $uri.");
}
+# ---------------------------------------------------- Store away initial state
+ {
+ my $cfh;
+ if (open($cfh,">$fn.state")) {
+ print $cfh join("\n",@cond);
+ } else {
+ &Apache::lonnet::logthis("WARNING: ".
+ "Could not write statemap $fn for $uri.");
+ }
+ }
+ flock(LOCKFILE,LOCK_UN);
+ close(LOCKFILE);
+ } else {
+ # if we are here it is likely because we are already trying to
+ # initialize the course in another child, busy wait trying to
+ # tie the hashes for the next 90 seconds, if we succeed forward
+ # them on to navmaps, if we fail, throw up the Could not init
+ # course screen
+ if ($lock) {
+ # Got the lock but not the DB files
+ flock(LOCKFILE,LOCK_UN);
+ }
+ untie(%hash);
+ untie(%parmhash);
+ &Apache::lonnet::logthis("WARNING: ".
+ "Could not tie coursemap $fn for $uri.");
+ my $i=0;
+ while($i<90) {
+ $i++;
+ sleep(1);
+ if (flock(LOCKFILE,LOCK_EX|LOCK_NB) &&
+ (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {
+ if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
+ $retfurl='/adm/navmaps';
+ &Apache::lonnet::appenv("request.course.id" => $short,
+ "request.course.fn" => $fn,
+ "request.course.uri" => $uri);
+ untie(%hash);
+ untie(%parmhash);
+ last;
+ }
+ }
+ untie(%hash);
+ untie(%parmhash);
+ }
+ flock(LOCKFILE,LOCK_UN);
+ close(LOCKFILE);
}
- unless ((untie(%hash)) && (untie(%parmhash))) {
- &Apache::lonnet::logthis("WARNING: ".
- "Could not untie coursemap $fn for $uri.");
- }
- {
- my $cfh;
- if ($cfh=Apache::File->new(">$fn.state")) {
- print $cfh join("\n",@cond);
- } else {
- &Apache::lonnet::logthis("WARNING: ".
- "Could not write statemap $fn for $uri.");
- }
- }
- } else {
- &Apache::lonnet::logthis("WARNING: ".
- "Could not tie coursemap $fn for $uri.");
- }
- &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
+ &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext);
# ------------------------------------------------- Check for critical messages
- my @what=&Apache::lonnet::dump('critical',$ENV{'user.domain'},
- $ENV{'user.name'});
+ my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
+ $env{'user.name'});
if ($what[0]) {
if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
$retfurl='/adm/email?critical=display';
}
}
- return ($retfurl,$errtext);
+ return ($retfurl,$errtext);
}
# ------------------------------------------------------- Evaluate state string
sub evalstate {
-
- my $fn=$ENV{'request.course.fn'}.'.state';
- my $state='2';
+ my $fn=$env{'request.course.fn'}.'.state';
+ my $state='';
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');
- foreach (@conditions) {
- 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';
- }
- }
- }
+ 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');
+ foreach my $line (@conditions) {
+ chomp($line);
+ my ($condition,$weight)=split(/\:/,$line);
+ if ($safeeval->reval($condition)) {
+ if ($weight eq 'force') {
+ $state.='3';
+ } else {
+ $state.='2';
+ }
+ } else {
+ if ($weight eq 'stop') {
+ $state.='0';
+ } else {
+ $state.='1';
+ }
+ }
+ }
}
- &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);
+ &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state);
return $state;
}
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.