--- rat/lonuserstate.pm 2007/06/28 23:26:38 1.118.2.2
+++ rat/lonuserstate.pm 2011/07/26 10:40:23 1.138
@@ -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.118.2.2 2007/06/28 23:26:38 albertel Exp $
+# $Id: lonuserstate.pm,v 1.138 2011/07/26 10:40:23 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,11 +43,13 @@ use Opcode;
use Apache::lonenc;
use Fcntl qw(:flock);
use LONCAPA;
+use File::Basename;
+
# ---------------------------------------------------- Globals for this package
-my $pc; # Package counter
+my $pc; # Package counter is this what 'Guts' calls the map counter?
my %hash; # The big tied hash
my %parmhash;# The hash with the parameters
my @cond; # Array with all of the conditions
@@ -62,6 +64,12 @@ my %hiddenurl; # this URL (or complete f
# ----------------------------------- Remove version from URL and store in hash
+sub versionerror {
+ my ($uri,$usedversion,$unusedversion)=@_;
+ return '
'.&mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].',
+ $uri,$usedversion,$unusedversion).'
';
+}
+
sub versiontrack {
my $uri=shift;
if ($uri=~/\.(\d+)\.\w+$/) {
@@ -69,7 +77,9 @@ sub versiontrack {
$uri=~s/\.\d+\.(\w+)$/\.$1/;
unless ($hash{'version_'.$uri}) {
$hash{'version_'.$uri}=$version;
- }
+ } elsif ($version!=$hash{'version_'.$uri}) {
+ $errtext.=&versionerror($uri,$hash{'version_'.$uri},$version);
+ }
}
return $uri;
}
@@ -104,30 +114,55 @@ sub processversionfile {
}
}
-# --------------------------------------------------------- Loads map from disk
+# --------------------------------------------------------- Loads from disk
sub loadmap {
my ($uri,$parent_rid)=@_;
+
+ # Is the map already included?
+
if ($hash{'map_pc_'.$uri}) {
- $errtext.=&mt('
Multiple use of sequence/page [_1]! The course will not function properly.',$uri);
+ $errtext.='
'.
+ &mt('Multiple use of sequence/page [_1]! The course will not function properly.',''.$uri.'').
+ '
';
return;
}
+ # Register the resource in it's map_pc_ [for the URL]
+ # map_id.nnn is the nesting level -> to the URI.
+
$pc++;
my $lpc=$pc;
$hash{'map_pc_'.$uri}=$lpc;
$hash{'map_id_'.$lpc}=$uri;
-# Determine and check filename
+ # If the parent is of the form n.m hang this map underneath it in the
+ # map hierarchy.
+
+ if ($parent_rid =~ /^(\d+)\.\d+$/) {
+ my $parent_pc = $1;
+ if (defined($hash{'map_hierarchy_'.$parent_pc})) {
+ $hash{'map_hierarchy_'.$lpc}=$hash{'map_hierarchy_'.$parent_pc}.','.
+ $parent_pc;
+ } else {
+ $hash{'map_hierarchy_'.$lpc}=$parent_pc;
+ }
+ }
+
+# Determine and check filename of the sequence we need to read:
+
my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));
my $ispage=($fn=~/\.page$/);
- unless (($fn=~/\.sequence$/) ||
- ($fn=~/\.page$/)) {
+ # We can only nest sequences or pages. Anything else is an illegal nest.
+
+ unless (($fn=~/\.sequence$/) || $ispage) {
$errtext.=&mt("
Invalid map: [_1]",$fn);
return;
}
+ # Read the XML that constitutes the file.
+
my $instr=&Apache::lonnet::getfile($fn);
if ($instr eq -1) {
@@ -135,18 +170,29 @@ sub loadmap {
return;
}
-# Successfully got file, parse it
+ # Successfully got file, parse it
+
+ # parse for parameter processing.
+ # Note that these are tags
+ # so we only care about 'S' (tag start) nodes.
+
my $parser = HTML::TokeParser->new(\$instr);
$parser->attr_encoded(1);
+
# first get all parameters
+
+
while (my $token = $parser->get_token) {
next if ($token->[0] ne 'S');
if ($token->[1] eq 'param') {
&parse_param($token,$lpc);
}
}
- #reset parser
+
+ # Get set to take another pass through the XML:
+ # for resources and links.
+
$parser = HTML::TokeParser->new(\$instr);
$parser->attr_encoded(1);
@@ -158,29 +204,61 @@ sub loadmap {
my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
+ # Parse the resources, link and condition tags.
+ # Note that if randomorder or random select is chosen the links and
+ # conditions are meaningless but are determined by the randomization.
+ # This is handled in the next chunk of code.
+
my @map_ids;
while (my $token = $parser->get_token) {
next if ($token->[0] ne 'S');
+
+ # Resource
+
if ($token->[1] eq 'resource') {
- push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));
+ my $resource_id = &parse_resource($token,$lpc,$ispage,$uri);
+ if (defined $resource_id) {
+ push(@map_ids, $resource_id);
+ }
+
+ # Link
+
} elsif ($token->[1] eq 'link' && !$randomize) {
-# ----------------------------------------------------------------------- Links
&make_link(++$linkpc,$lpc,$token->[2]->{'to'},
$token->[2]->{'from'},
$token->[2]->{'condition'});
+
+ # condition
+
} elsif ($token->[1] eq 'condition' && !$randomize) {
&parse_condition($token,$lpc);
}
}
+
+ # Handle randomization and random selection
+
if ($randomize) {
- my $seed = (split(/\./,$parent_rid))[1];
- if ($randompickseed{$parent_rid}) {
- $seed = $randompickseed{$parent_rid};
+ if (!$env{'request.role.adv'}) {
+ my $seed;
+ if (defined($randompickseed{$parent_rid})) {
+ $seed = $randompickseed{$parent_rid};
+ } else {
+ my ($mapid,$resid)=split(/\./,$parent_rid);
+ my $symb=
+ &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
+ $resid,$hash{'src_'.$parent_rid});
+
+ $seed = $symb;
+ }
+
+ # Here for sure we need to pass along the username/domain
+ # so that we can impersonate users in lonprintout e.g.
+
+ my $rndseed=&Apache::lonnet::rndseed($seed);
+ &Apache::lonnet::setup_random_from_rndseed($rndseed);
+ @map_ids=&Math::Random::random_permutation(@map_ids);
}
- my $rndseed=&Apache::lonnet::rndseed($seed);
- &Apache::lonnet::setup_random_from_rndseed($rndseed);
- my @map_ids=&Math::Random::random_permutation(@map_ids);
my $from = shift(@map_ids);
my $from_rid = $lpc.'.'.$from;
$hash{'map_start_'.$uri} = $from_rid;
@@ -197,13 +275,67 @@ sub loadmap {
$hash{'map_finish_'.$uri}= $from_rid;
$hash{'type_'.$from_rid}='finish';
}
+
+ $parser = HTML::TokeParser->new(\$instr);
+ $parser->attr_encoded(1);
+ # last parse out the mapalias params so as to ignore anything
+ # refering to non-existant resources
+ while (my $token = $parser->get_token) {
+ next if ($token->[0] ne 'S');
+ if ($token->[1] eq 'param') {
+ &parse_mapalias_param($token,$lpc);
+ }
+ }
}
# -------------------------------------------------------------------- Resource
+#
+# Parses a resource tag to produce the value to push into the
+# map_ids array.
+#
+#
+# Information about the actual type of resource is provided by the file extension
+# of the uri (e.g. .problem, .sequence etc. etc.).
+#
+# Parameters:
+# $token - A token from HTML::TokeParser
+# This is an array that describes the most recently parsed HTML item.
+# $lpc - Map nesting level (?)
+# $ispage - True if this resource is encapsulated in a .page (assembled resourcde).
+# $uri - URI of the enclosing resource.
+# Returns:
+#
+# Note:
+# The token is an array that contains the following elements:
+# [0] => 'S' indicating this is a start token
+# [1] => 'resource' indicating this tag is a tag.
+# [2] => Hash of attribute =>value pairs.
+# [3] => @(keys [2]).
+# [4] => unused.
+#
+# The attributes of the resourcde tag include:
+#
+# id - The resource id.
+# src - The URI of the resource.
+# type - The resource type (e.g. start and finish).
+# title - The resource title.
+
+
sub parse_resource {
my ($token,$lpc,$ispage,$uri) = @_;
- if ($token->[2]->{'type'} eq 'zombie') { next; }
+
+ # I refuse to coutenance code like this that has
+ # such a dirty side effect (and forcing this sub to be called within a loop).
+ #
+ # if ($token->[2]->{'type'} eq 'zombie') { next; }
+
+ # Zombie resources don't produce anything useful.
+
+ if ($token->[2]->{'type'} eq 'zombie') {
+ return undef;
+ }
+
my $rid=$lpc.'.'.$token->[2]->{'id'};
$hash{'kind_'.$rid}='res';
@@ -224,7 +356,7 @@ sub parse_resource {
$turi=~/\.(\w+)$/;
my $embstyle=&Apache::loncommon::fileembstyle($1);
if ($token->[2]->{'external'} eq 'true') { # external
- $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
+ $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//;
} elsif ($turi=~/^\/*uploaded\//) { # uploaded
if (($embstyle eq 'img')
|| ($embstyle eq 'emb')
@@ -255,7 +387,7 @@ sub parse_resource {
$hash{'ids_'.$idsuri}=''.$rid;
}
- if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
+ if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) {
$turi.='?register=1';
}
@@ -320,7 +452,10 @@ sub parse_condition {
my $rid=$lpc.'.'.$token->[2]->{'id'};
$hash{'kind_'.$rid}='cond';
- $cond[$#cond+1]=$token->[2]->{'value'};
+
+ my $condition = $token->[2]->{'value'};
+ $condition =~ s/[\n\r]+/ /gs;
+ push(@cond, $condition);
$hash{'condid_'.$rid}=$#cond;
if ($token->[2]->{'type'}) {
$cond[$#cond].=':'.$token->[2]->{'type'};
@@ -330,40 +465,77 @@ sub parse_condition {
}
# ------------------------------------------------------------------- Parameter
+# Parse a tag in the map.
+# Parmameters:
+# $token Token array for a start tag from HTML::TokeParser
+# [0] = 'S'
+# [1] = tagname ("param")
+# [2] = Hash of {attribute} = values.
+# [3] = Array of the keys in [2].
+# [4] = unused.
+# $lpc Current map nesting level.a
+#
+# Typical attributes:
+# to=n - Number of the resource the parameter applies to.
+# type=xx - Type of parameter value (e.g. string_yesno or int_pos).
+# name=xxx - Name ofr parameter (e.g. parameter_randompick or parameter_randomorder).
+# value=xxx - value of the parameter.
sub parse_param {
my ($token,$lpc) = @_;
- my $referid=$lpc.'.'.$token->[2]->{'to'};
- my $name=$token->[2]->{'name'};
+ my $referid=$lpc.'.'.$token->[2]->{'to'}; # Resource param applies to.
+ my $name=$token->[2]->{'name'}; # Name of parameter
my $part;
- if ($name=~/^parameter_(.*)_/) {
+
+
+ if ($name=~/^parameter_(.*)_/) {
$part=$1;
} else {
$part=0;
}
+
+ # Peel the parameter_ off the parameter name.
+
$name=~s/^.*_([^_]*)$/$1/;
+
+ # The value is:
+ # type.part.name.value
+
my $newparam=
&escape($token->[2]->{'type'}).':'.
&escape($part.'.'.$name).'='.
&escape($token->[2]->{'value'});
+
+ # The hash key is param_resourceid.
+ # Multiple parameters for a single resource are & separated in the hash.
+
+
if (defined($hash{'param_'.$referid})) {
$hash{'param_'.$referid}.='&'.$newparam;
} else {
$hash{'param_'.$referid}=''.$newparam;
}
- if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
- $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
- }
- if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {
+ #
+ # These parameters have to do with randomly selecting
+ # resources, therefore a separate hash is also created to
+ # make it easy to locate them when actually computing the resource set later on
+ # See the code conditionalized by ($randomize) in loadmap().
+
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { # Random selection turned on
$randompick{$referid}=$token->[2]->{'value'};
}
- if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { # Randomseed provided.
$randompickseed{$referid}=$token->[2]->{'value'};
}
- if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) {
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { # Random order turned on.
$randomorder{$referid}=$token->[2]->{'value'};
- &Apache::lonnet::logthis("roing $referid ".$randomorder{$referid});
}
+
+ # These parameters have to do with how the URLs of resources are presented to
+ # course members(?). encrypturl presents encypted url's while
+ # hiddenresource hides the URL.
+ #
+
if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
if ($token->[2]->{'value'}=~/^yes$/i) {
$encurl{$referid}=1;
@@ -376,6 +548,17 @@ sub parse_param {
}
}
+sub parse_mapalias_param {
+ my ($token,$lpc) = @_;
+ my $referid=$lpc.'.'.$token->[2]->{'to'};
+ return if (!exists($hash{'src_'.$referid}));
+
+ if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
+ &count_mapalias($token->[2]->{'value'},$referid);
+ $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
+ }
+}
+
# --------------------------------------------------------- Simplify expression
sub simplify {
@@ -404,7 +587,7 @@ sub simplify {
sub traceroute {
my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
my $newsofar=$sofar=simplify($sofar);
- unless ($beenhere=~/\&$rid\&/) {
+ unless ($beenhere=~/\&\Q$rid\E\&/) {
$beenhere.=$rid.'&';
my ($mapid,$resid)=split(/\./,$rid);
my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
@@ -438,7 +621,8 @@ sub traceroute {
if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
$sofar=$newsofar=
&traceroute($sofar,
- $hash{'map_start_'.$hash{'src_'.$rid}},'&',
+ $hash{'map_start_'.$hash{'src_'.$rid}},
+ $beenhere,
$encflag || $encurl{$rid},
$hdnflag || $hiddenurl{$rid});
}
@@ -539,8 +723,9 @@ sub accinit {
$acchash{'acc.res.'.$short.'.'}='&:0&';
my $courseuri=$uri;
$courseuri=~s/^\/res\///;
- &Apache::lonnet::delenv('(acc\.|httpref\.)');
- &Apache::lonnet::appenv(%acchash);
+ my $regexp = 1;
+ &Apache::lonnet::delenv('(acc\.|httpref\.)',$regexp);
+ &Apache::lonnet::appenv(\%acchash);
}
# ---------------- Selectively delete from randompick maps and hidden url parms
@@ -596,7 +781,7 @@ sub hiddenurls {
}
# --------------------------------------- append randomout entry to environment
if ($randomoutentry) {
- &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
+ &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry});
}
}
@@ -605,133 +790,229 @@ sub hiddenurls {
sub readmap {
my $short=shift;
$short=~s/^\///;
- my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1});
+
+ # TODO: Hidden dependency on current user:
+
+ my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1});
+
my $fn=$cenv{'fn'};
my $uri;
$short=~s/\//\_/g;
unless ($uri=$cenv{'url'}) {
- &Apache::lonnet::logthis("WARNING: ".
+ &Apache::lonnet::logthis('WARNING: '.
"Could not load course $short.");
return ('',&mt('No course data available.'));;
}
@cond=('true:normal');
- open(LOCKFILE,">$fn.db.lock");
+ unless (open(LOCKFILE,">$fn.db.lock")) {
+ #
+ # Most likely a permissions problem on the lockfile or its directory.
+ #
+ $errtext.='
'.&mt('Map not loaded - Lock file could not be opened when reading map:').' '.$fn.'.';
+ $retfurl = '';
+ return ($retfurl,$errtext);
+ }
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');
+ my $gotstate=0;
+
+ # If we can get the lock without delay any files there are idle
+ # and from some prior request. We'll kill them off and regenerate them:
+
+ if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
+ $lock=1; # Remember that we hold the lock.
+ &unlink_tmpfiles($fn);
}
undef %randompick;
undef %hiddenurl;
undef %encurl;
$retfrid='';
- 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,'0.0');
- if (defined($hash{'map_start_'.$uri})) {
- &Apache::lonnet::appenv("request.course.id" => $short,
- "request.course.fn" => $fn,
- "request.course.uri" => $uri);
- $env{'request.course.id'}=$short;
- &traceroute('0',$hash{'map_start_'.$uri},'&');
- &accinit($uri,$short,$fn);
- &hiddenurls();
- }
-# ------------------------------------------------------- Put versions into src
- 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 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
- $hash{'first_rid'}=$retfrid;
- my ($mapid,$resid)=split(/\./,$retfrid);
- $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};
- my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});
- $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });
- if ($hash{'encrypted_'.$retfrid}) {
- $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));
- }
- $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 {
+ my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.
+
+ # if we got the lock, regenerate course regnerate empty files and tie them.
+
+ if ($lock) {
+ if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
+ $tiedhash = 1;
+ if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
+ $tiedparmhash = 1;
+ $gotstate = &build_tmp_hashes($uri,
+ $fn,
+ $short,
+ \%cenv); # TODO: Need to provide requested user@dom
+ unless ($gotstate) {
+ &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.');
+ }
+ $untiedparmhash = untie(%parmhash);
+ unless ($untiedparmhash) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.');
+ }
+ }
+ $untiedhash = untie(%hash);
+ unless ($untiedhash) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap hash '.$fn.' for '.$uri.'.');
+ }
+ }
+ flock(LOCKFILE,LOCK_UN); # RF: this is what I don't get unless there are other
+ # unlocked places the remainder happens..seems like if we
+ # just kept the lock here the rest of the code would have
+ # been much easier?
+ }
+ unless ($lock && $tiedhash && $tiedparmhash) {
# 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
+ #
+ # RF: I'm not seeing the case where the ties/unties can fail in a way
+ # that can be remedied by this. Since we owned the lock seems
+ # Tie/untie failures are a result of something like a permissions problem instead?
+ #
+
+ # In any vent, undo what we did manage to do above first:
if ($lock) {
# Got the lock but not the DB files
flock(LOCKFILE,LOCK_UN);
+ $lock = 0;
}
- untie(%hash);
- untie(%parmhash);
- &Apache::lonnet::logthis("WARNING: ".
- "Could not tie coursemap $fn for $uri.");
+ if ($tiedhash) {
+ unless($untiedhash) {
+ untie(%hash);
+ }
+ }
+ if ($tiedparmhash) {
+ unless($untiedparmhash) {
+ untie(%parmhash);
+ }
+ }
+ # Log our failure:
+
+ &Apache::lonnet::logthis('WARNING: '.
+ "Could not tie coursemap $fn for $uri.");
+ $tiedhash = '';
+ $tiedparmhash = '';
my $i=0;
+
+ # Keep on retrying the lock for 90 sec until we succeed.
+
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);
+ if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
+
+ # Got the lock, tie the hashes...the assumption in this code is
+ # that some other worker thread has created the db files quite recently
+ # so no load is needed:
+
+ $lock = 1;
+ if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
+ $tiedhash = 1;
+ if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
+ $tiedparmhash = 1;
+ if (-e "$fn.state") {
+ $retfurl='/adm/navmaps';
+
+ # BUG BUG: Side effect!
+ # Should conditionalize on something so that we can use this
+ # to load maps for courses that are not current?
+ #
+ &Apache::lonnet::appenv({"request.course.id" => $short,
+ "request.course.fn" => $fn,
+ "request.course.uri" => $uri});
+ $untiedhash = untie(%hash);
+ $untiedparmhash = untie(%parmhash);
+ $gotstate = 1;
+ last;
+ }
+ $untiedparmhash = untie(%parmhash);
+ }
+ $untiedhash = untie(%hash);
+ }
+ }
}
- flock(LOCKFILE,LOCK_UN);
- close(LOCKFILE);
+ if ($lock) {
+ flock(LOCKFILE,LOCK_UN);
+ $lock = 0;
+ if ($tiedparmhash) {
+ unless ($untiedparmhash) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.');
+ }
+ }
+ if ($tiedparmhash) {
+ unless ($untiedhash) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap hash '.$fn.' for '.$uri.'.');
+ }
+ }
+ }
+ }
+ # I think this branch of code is all about what happens if we just did the stuff above,
+ # but found that the state file did not exist...again if we'd just held the lock
+ # would that have made this logic simpler..as generating all the files would be
+ # an atomic operation with respect to the lock.
+ #
+ unless ($gotstate) {
+ $lock = 0;
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not read statemap '.$fn.' for '.$uri.'.');
+ &unlink_tmpfiles($fn);
+ if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
+ $lock=1;
+ }
+ undef %randompick;
+ undef %hiddenurl;
+ undef %encurl;
+ $retfrid='';
+ #
+ # Once more through the routine of tying and loading and so on.
+ #
+ if ($lock) {
+ if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
+ if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
+ $gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv); # TODO: User dependent?
+ unless ($gotstate) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Failed to write statemap at second attempt '.$fn.' for '.$uri.'.');
+ }
+ unless (untie(%parmhash)) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap parmhash '.$fn.'.db for '.$uri.'.');
+ }
+ } else {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not tie coursemap '.$fn.'__parms.db for '.$uri.'.');
+ }
+ unless (untie(%hash)) {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not untie coursemap hash '.$fn.'.db for '.$uri.'.');
+ }
+ } else {
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not tie coursemap '.$fn.'.db for '.$uri.'.');
+ }
+ flock(LOCKFILE,LOCK_UN);
+ $lock = 0;
+ } else {
+ # Failed to get the immediate lock.
+
+ &Apache::lonnet::logthis('WARNING: '.
+ 'Could not obtain lock to tie coursemap hash '.$fn.'.db for '.$uri.'.');
+ }
+ }
+ close(LOCKFILE);
+ unless (($errtext eq '') || ($env{'request.course.uri'} =~ m{^/uploaded/})) {
+ &Apache::lonmsg::author_res_msg($env{'request.course.uri'},
+ $errtext); # TODO: User dependent?
}
- &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext);
# ------------------------------------------------- Check for critical messages
+# Depends on user must parameterize this as well..or separate as this is:
+# more part of determining what someone sees on entering a course?
+
my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
$env{'user.name'});
if ($what[0]) {
@@ -742,6 +1023,112 @@ sub readmap {
return ($retfurl,$errtext);
}
+#
+# This sub is called when the course hash and the param hash have been tied and
+# their lock file is held.
+# Parameters:
+# $uri - URI that identifies the course.
+# $fn - The base path/filename of the files that make up the context
+# being built.
+# $short - Short course name.
+# $cenvref - Reference to the course environment hash returned by
+# Apache::lonnet::coursedescription
+#
+# Assumptions:
+# The globals
+# %hash, %paramhash are tied to their gdbm files and we hold the lock on them.
+#
+sub build_tmp_hashes {
+ my ($uri,$fn,$short,$cenvref) = @_;
+
+ unless(ref($cenvref) eq 'HASH') {
+ return;
+ }
+ my %cenv = %{$cenvref};
+ my $gotstate = 0;
+ %hash=(); # empty the global course and parameter hashes.
+ %parmhash=();
+ $errtext=''; # No error messages yet.
+ $pc=0;
+ &clear_mapalias_count();
+ &processversionfile(%cenv);
+ my $furi=&Apache::lonnet::clutter($uri);
+ #
+ # the map staring points.
+ #
+ $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,'0.0');
+ if (defined($hash{'map_start_'.$uri})) {
+ &Apache::lonnet::appenv({"request.course.id" => $short,
+ "request.course.fn" => $fn,
+ "request.course.uri" => $uri});
+ $env{'request.course.id'}=$short;
+ &traceroute('0',$hash{'map_start_'.$uri},'&');
+ &accinit($uri,$short,$fn);
+ &hiddenurls();
+ }
+ $errtext .= &get_mapalias_errors();
+# ------------------------------------------------------- Put versions into src
+ 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 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
+ $hash{'first_rid'}=$retfrid;
+ my ($mapid,$resid)=split(/\./,$retfrid);
+ $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};
+ my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});
+ $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });
+ if ($hash{'encrypted_'.$retfrid}) {
+ $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));
+ }
+ $hash{'first_url'}=$retfurl;
+# ---------------------------------------------------- Store away initial state
+ {
+ my $cfh;
+ if (open($cfh,">$fn.state")) {
+ print $cfh join("\n",@cond);
+ $gotstate = 1;
+ } else {
+ &Apache::lonnet::logthis("WARNING: ".
+ "Could not write statemap $fn for $uri.");
+ }
+ }
+ return $gotstate;
+}
+
+sub unlink_tmpfiles {
+ my ($fn) = @_;
+ my $file_dir = dirname($fn);
+
+ if ($fn eq LONCAPA::tempdir()) {
+ my @files = qw (.db _symb.db .state _parms.db);
+ foreach my $file (@files) {
+ if (-e $fn.$file) {
+ unless (unlink($fn.$file)) {
+ &Apache::lonnet::logthis("WARNING: ".
+ "Could not unlink ".$fn.$file."");
+ }
+ }
+ }
+ }
+ return;
+}
+
# ------------------------------------------------------- Evaluate state string
sub evalstate {
@@ -778,10 +1165,50 @@ sub evalstate {
}
}
}
- &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state);
+ &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state});
return $state;
}
+# This block seems to have code to manage/detect doubly defined
+# aliases in maps.
+
+{
+ my %mapalias_cache;
+ sub count_mapalias {
+ my ($value,$resid) = @_;
+ push(@{ $mapalias_cache{$value} }, $resid);
+ }
+
+ sub get_mapalias_errors {
+ my $error_text;
+ foreach my $mapalias (sort(keys(%mapalias_cache))) {
+ next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);
+ my $count;
+ my $which =
+ join('',
+ map {
+ my $id = $_;
+ if (exists($hash{'src_'.$id})) {
+ $count++;
+ }
+ my ($mapid) = split(/\./,$id);
+ &mt('Resource "[_1]"
in Map "[_2]"',
+ $hash{'title_'.$id},
+ $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
+ } (@{ $mapalias_cache{$mapalias} }));
+ next if ($count < 2);
+ $error_text .= ''.
+ &mt('Error: Found the mapalias "[_1]" defined multiple times.',
+ $mapalias).
+ '
';
+ }
+ &clear_mapalias_count();
+ return $error_text;
+ }
+ sub clear_mapalias_count {
+ undef(%mapalias_cache);
+ }
+}
1;
__END__
@@ -804,37 +1231,33 @@ of course for user.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
-=head1 HANDLER SUBROUTINE
-
-There is no handler subroutine.
-
-=head1 OTHER SUBROUTINES
+=head1 SUBROUTINES
-=over 4
+=over
-=item *
+=item loadmap()
-loadmap() : Loads map from disk
+Loads map from disk
-=item *
+=item simplify()
-simplify() : Simplify expression
+Simplify expression
-=item *
+=item traceroute()
-traceroute() : Build condition hash
+Build condition hash
-=item *
+=item accinit()
-accinit() : Cascading conditions, quick access, parameters
+Cascading conditions, quick access, parameters
-=item *
+=item readmap()
-readmap() : Read map and all submaps
+Read map and all submaps
-=item *
+=item evalstate()
-evalstate() : Evaluate state string
+Evaluate state string
=back