rat/lonuserstate.pm - diff

Return to lonuserstate.pm CVS log

Up to [LON-CAPA] / rat

Diff for /rat/lonuserstate.pm between versions 1.132 and 1.153

version 1.132, 2009/11/15 14:08:53	version 1.153, 2017/09/03 18:52:23
Line 42 use Safe::Hole;	Line 42 use Safe::Hole;
use Opcode;	use Opcode;
use Apache::lonenc;	use Apache::lonenc;
use Fcntl qw(:flock);	use Fcntl qw(:flock);
use LONCAPA;	use LONCAPA qw(:DEFAULT :match);
	use File::Basename;



# ---------------------------------------------------- Globals for this package	# ---------------------------------------------------- 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 %hash; # The big tied hash
my %parmhash;# The hash with the parameters	my %parmhash;# The hash with the parameters
my @cond; # Array with all of the conditions	my @cond; # Array with all of the conditions
Line 57 my $retfurl; # first URL	Line 59 my $retfurl; # first URL
my %randompick; # randomly picked resources	my %randompick; # randomly picked resources
my %randompickseed; # optional seed for randomly picking resources	my %randompickseed; # optional seed for randomly picking resources
my %randomorder; # maps to order contents randomly	my %randomorder; # maps to order contents randomly
	my %randomizationcode; # code used to grade folder for bubblesheet exam
my %encurl; # URLs in this folder are supposed to be encrypted	my %encurl; # URLs in this folder are supposed to be encrypted
my %hiddenurl; # this URL (or complete folder) is supposed to be hidden	my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
	my %rescount; # count of unhidden items in each map
	my %mapcount; # count of unhidden maps in each map

# ----------------------------------- Remove version from URL and store in hash	# ----------------------------------- Remove version from URL and store in hash

	sub versionerror {
	my ($uri,$usedversion,$unusedversion)=@_;
	return '<br />'.&mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].',
	$uri,$usedversion,$unusedversion).'<br />';
	}

	# Removes the version number from a URI and returns the resulting
	# URI (e.g. mumbly.version.stuff => mumbly.stuff).
	#
	# If the URI has not been seen with a versio before the
	# hash{'version_'.resultingURI} is set to the version number.
	# If the URI has been seen and the version does not match and error
	# is added to the error string.
	#
	# Parameters:
	# URI potentially with a version.
	# Returns:
	# URI with the version cut out.
	# See above for side effects.
	#

sub versiontrack {	sub versiontrack {
my $uri=shift;	my $uri=shift;
if ($uri=~/\.(\d+)\.\w+$/) {	if ($uri=~/\.(\d+)\.\w+$/) {
Line 69 sub versiontrack {	Line 95 sub versiontrack {
$uri=~s/\.\d+\.(\w+)$/\.$1/;	$uri=~s/\.\d+\.(\w+)$/\.$1/;
unless ($hash{'version_'.$uri}) {	unless ($hash{'version_'.$uri}) {
$hash{'version_'.$uri}=$version;	$hash{'version_'.$uri}=$version;
}	} elsif ($version!=$hash{'version_'.$uri}) {
	$errtext.=&versionerror($uri,$hash{'version_'.$uri},$version);
	}
}	}
return $uri;	return $uri;
}	}
Line 104 sub processversionfile {	Line 132 sub processversionfile {
}	}
}	}

# --------------------------------------------------------- Loads map from disk	# --------------------------------------------------------- Loads from disk


	#
	# Loads a map file.
	# Note that this may implicitly recurse via parse_resource if one of the resources
	# is itself composed.
	#
	# Parameters:
	# uri - URI of the map file.
	# parent_rid - Resource id in the map of the parent resource (0.0 for the top level map)
	# courseid - Course id for the course for which the map is being loaded
	#
sub loadmap {	sub loadmap {
my ($uri,$parent_rid)=@_;	my ($uri,$parent_rid,$courseid)=@_;

	# Is the map already included?

if ($hash{'map_pc_'.$uri}) {	if ($hash{'map_pc_'.$uri}) {
$errtext.='<p class="LC_error">'.	$errtext.='<p class="LC_error">'.
&mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').	&mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
'</p>';	'</p>';
return;	return;
}	}
	# Register the resource in it's map_pc_ [for the URL]
	# map_id.nnn is the nesting level -> to the URI.

$pc++;	$pc++;
my $lpc=$pc;	my $lpc=$pc;
$hash{'map_pc_'.$uri}=$lpc;	$hash{'map_pc_'.$uri}=$lpc;
$hash{'map_id_'.$lpc}=$uri;	$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 $fn=&Apache::lonnet::filelocation('',&putinversion($uri));

my $ispage=($fn=~/\.page$/);	my $ispage=($fn=~/\.page$/);

unless (($fn=~/\.sequence$/) \|\|	# We can only nest sequences or pages. Anything else is an illegal nest.
($fn=~/\.page$/)) {
$errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);	unless (($fn=~/\.sequence$/) \|\| $ispage) {
	$errtext.='<br />'.&mt('Invalid map: [_1]',"<tt>$fn</tt>");
return;	return;
}	}

	# Read the XML that constitutes the file.

my $instr=&Apache::lonnet::getfile($fn);	my $instr=&Apache::lonnet::getfile($fn);

if ($instr eq -1) {	if ($instr eq -1) {
$errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);	$errtext.= '<br />'
	.&mt('Map not loaded: The file [_1] does not exist.',
	"<tt>$fn</tt>");
return;	return;
}	}

# Successfully got file, parse it	# Successfully got file, parse it

	# parse for parameter processing.
	# Note that these are <param... / > tags
	# so we only care about 'S' (tag start) nodes.


my $parser = HTML::TokeParser->new(\$instr);	my $parser = HTML::TokeParser->new(\$instr);
$parser->attr_encoded(1);	$parser->attr_encoded(1);

# first get all parameters	# first get all parameters


while (my $token = $parser->get_token) {	while (my $token = $parser->get_token) {
next if ($token->[0] ne 'S');	next if ($token->[0] ne 'S');
if ($token->[1] eq 'param') {	if ($token->[1] eq 'param') {
&parse_param($token,$lpc);	&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 = HTML::TokeParser->new(\$instr);
$parser->attr_encoded(1);	$parser->attr_encoded(1);

Line 160 sub loadmap {	Line 235 sub loadmap {

my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);	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;	my @map_ids;
	my $codechecked;
	$rescount{$lpc} = 0;
	$mapcount{$lpc} = 0;
while (my $token = $parser->get_token) {	while (my $token = $parser->get_token) {
next if ($token->[0] ne 'S');	next if ($token->[0] ne 'S');

	# Resource

if ($token->[1] eq 'resource') {	if ($token->[1] eq 'resource') {
push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));	my $resource_id = &parse_resource($token,$lpc,$ispage,$uri,$courseid);
	if (defined $resource_id) {
	push(@map_ids, $resource_id);
	if ($hash{'src_'.$lpc.'.'.$resource_id}) {
	$rescount{$lpc} ++;
	if (($hash{'src_'.$lpc.'.'.$resource_id}=~/\.sequence$/) \|\|
	($hash{'src_'.$lpc.'.'.$resource_id}=~/\.page$/)) {
	$mapcount{$lpc} ++;
	}
	}
	unless ($codechecked) {
	my $startsymb =
	&Apache::lonnet::encode_symb($hash{'map_id_'.$lpc},$resource_id,
	$hash{'src_'."$lpc.$resource_id"});
	my $code =
	&Apache::lonnet::EXT('resource.0.examcode',$startsymb,undef,undef,
	undef,undef,$courseid);
	if ($code) {
	$randomizationcode{$parent_rid} = $code;
	}
	$codechecked = 1;
	}
	}

	# Link

} elsif ($token->[1] eq 'link' && !$randomize) {	} elsif ($token->[1] eq 'link' && !$randomize) {
# ----------------------------------------------------------------------- Links
&make_link(++$linkpc,$lpc,$token->[2]->{'to'},	&make_link(++$linkpc,$lpc,$token->[2]->{'to'},
$token->[2]->{'from'},	$token->[2]->{'from'},
$token->[2]->{'condition'});	$token->[2]->{'condition'}); # note ..condition may be undefined.

	# condition

} elsif ($token->[1] eq 'condition' && !$randomize) {	} elsif ($token->[1] eq 'condition' && !$randomize) {
&parse_condition($token,$lpc);	&parse_condition($token,$lpc);
}	}
}	}
	undef($codechecked);

	# Handle randomization and random selection

if ($randomize) {	if ($randomize) {
if (!$env{'request.role.adv'}) {	my $advanced;
	if ($env{'request.course.id'}) {
	$advanced = (&Apache::lonnet::allowed('adv') eq 'F');
	} else {
	$env{'request.course.id'} = $courseid;
	$advanced = (&Apache::lonnet::allowed('adv') eq 'F');
	$env{'request.course.id'} = '';
	}
	unless ($advanced) {
	# Order of resources is not randomized if user has and advanced role in the course.
my $seed;	my $seed;

	# If the map's random seed parameter has been specified
	# it is used as the basis for computing the seed ...

if (defined($randompickseed{$parent_rid})) {	if (defined($randompickseed{$parent_rid})) {
$seed = $randompickseed{$parent_rid};	$seed = $randompickseed{$parent_rid};
} else {	} else {

	# Otherwise the parent's fully encoded symb is used.

my ($mapid,$resid)=split(/\./,$parent_rid);	my ($mapid,$resid)=split(/\./,$parent_rid);
my $symb=	my $symb=
&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},	&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
Line 188 sub loadmap {	Line 320 sub loadmap {

$seed = $symb;	$seed = $symb;
}	}

	# TODO: Here for sure we need to pass along the username/domain
	# so that we can impersonate users in lonprintout e.g.

	my $setcode;
	if (defined($randomizationcode{$parent_rid})) {
	if ($env{'form.CODE'} eq '') {
	$env{'form.CODE'} = $randomizationcode{$parent_rid};
	$setcode = 1;
	}
	}

my $rndseed=&Apache::lonnet::rndseed($seed);	my $rndseed=&Apache::lonnet::rndseed($seed);
&Apache::lonnet::setup_random_from_rndseed($rndseed);	&Apache::lonnet::setup_random_from_rndseed($rndseed);

	if ($setcode) {
	undef($env{'form.CODE'});
	undef($setcode);
	}

	# Take the set of map ids we have decoded and permute them to a
	# random order based on the seed set above. All of this is
	# processing the randomorder parameter if it is set, not
	# randompick.

@map_ids=&Math::Random::random_permutation(@map_ids);	@map_ids=&Math::Random::random_permutation(@map_ids);
}	}

my $from = shift(@map_ids);	my $from = shift(@map_ids);
my $from_rid = $lpc.'.'.$from;	my $from_rid = $lpc.'.'.$from;
$hash{'map_start_'.$uri} = $from_rid;	$hash{'map_start_'.$uri} = $from_rid;
$hash{'type_'.$from_rid}='start';	$hash{'type_'.$from_rid}='start';

	# Create links to reflect the random re-ordering done above.
	# In the code to process the map XML, we did not process links or conditions
	# if randomorder was set. This means that for an instructor to choose

while (my $to = shift(@map_ids)) {	while (my $to = shift(@map_ids)) {
&make_link(++$linkpc,$lpc,$to,$from);	&make_link(++$linkpc,$lpc,$to,$from);
my $to_rid = $lpc.'.'.$to;	my $to_rid = $lpc.'.'.$to;
Line 212 sub loadmap {	Line 371 sub loadmap {

$parser = HTML::TokeParser->new(\$instr);	$parser = HTML::TokeParser->new(\$instr);
$parser->attr_encoded(1);	$parser->attr_encoded(1);
# last parse out the mapalias params so as to ignore anything
# refering to non-existant resources	# last parse out the mapalias params. These provide mnemonic
	# tags to resources that can be used in conditions

while (my $token = $parser->get_token) {	while (my $token = $parser->get_token) {
next if ($token->[0] ne 'S');	next if ($token->[0] ne 'S');
if ($token->[1] eq 'param') {	if ($token->[1] eq 'param') {
Line 224 sub loadmap {	Line 385 sub loadmap {


# -------------------------------------------------------------------- Resource	# -------------------------------------------------------------------- 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.
	# $courseid - Course id of the course containing the resource being parsed.
	# Returns:
	# Value of the id attribute of the tag.
	#
	# 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 <resource> 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 {	sub parse_resource {
my ($token,$lpc,$ispage,$uri) = @_;	my ($token,$lpc,$ispage,$uri,$courseid) = @_;
if ($token->[2]->{'type'} eq 'zombie') { next; }
my $rid=$lpc.'.'.$token->[2]->{'id'};	# I refuse to countenance 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; }
	#
	# The original code both returns _and_ skips to the next pass of the >caller's<
	# loop, that's just dirty.
	#

	# Zombie resources don't produce anything useful.

	if ($token->[2]->{'type'} eq 'zombie') {
	return undef;
	}

	my $rid=$lpc.'.'.$token->[2]->{'id'}; # Resource id in hash is levelcounter.id-in-xml.

	# Save the hash element type and title:

$hash{'kind_'.$rid}='res';	$hash{'kind_'.$rid}='res';
$hash{'title_'.$rid}=$token->[2]->{'title'};	$hash{'title_'.$rid}=$token->[2]->{'title'};

	# Get the version free URI for the resource.
	# If a 'version' attribute was supplied, and this resource's version
	# information has not yet been stored, store it.
	#

my $turi=&versiontrack($token->[2]->{'src'});	my $turi=&versiontrack($token->[2]->{'src'});
if ($token->[2]->{'version'}) {	if ($token->[2]->{'version'}) {
unless ($hash{'version_'.$turi}) {	unless ($hash{'version_'.$turi}) {
$hash{'version_'.$turi}=$1;	$hash{'version_'.$turi}=$1;
}	}
}	}
	# Pull out the title and do entity substitution on &colon
	# Q: Why no other entity substitutions?

my $title=$token->[2]->{'title'};	my $title=$token->[2]->{'title'};
$title=~s/\&colon\;/\:/gs;	$title=~s/\&colon\;/\:/gs;
# my $symb=&Apache::lonnet::encode_symb($uri,
# $token->[2]->{'id'},
# $turi);
# &Apache::lonnet::do_cache_new('title',$symb,$title);	# I think the point of all this code is to construct a final
	# URI that apache and its rewrite rules can use to
	# fetch the resource. Thi s sonly necessary if the resource
	# is not a page. If the resource is a page then it must be
	# assembled (at fetch time?).

unless ($ispage) {	unless ($ispage) {
$turi=~/\.(\w+)$/;	$turi=~/\.(\w+)$/;
my $embstyle=&Apache::loncommon::fileembstyle($1);	my $embstyle=&Apache::loncommon::fileembstyle($1);
Line 258 sub parse_resource {	Line 484 sub parse_resource {
} elsif ($turi!~/\.(sequence\|page)$/) {	} elsif ($turi!~/\.(sequence\|page)$/) {
$turi='/adm/coursedocs/showdoc'.$turi;	$turi='/adm/coursedocs/showdoc'.$turi;
}	}
	} elsif ($turi=~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
	$turi='/adm/wrapper'.$turi;
} elsif ($turi=~/\S/) { # normal non-empty internal resource	} elsif ($turi=~/\S/) { # normal non-empty internal resource
my $mapdir=$uri;	my $mapdir=$uri;
$mapdir=~s/[^\/]+$//;	$mapdir=~s/[^\/]+$//;
Line 269 sub parse_resource {	Line 497 sub parse_resource {
}	}
}	}
}	}
# Store reverse lookup, remove query string	# Store reverse lookup, remove query string resource 'ids'_uri => resource id.
	# If the URI appears more than one time in the sequence, it's resourcde
	# id's are constructed as a comma spearated list.

my $idsuri=$turi;	my $idsuri=$turi;
$idsuri=~s/\?.+$//;	$idsuri=~s/\?.+$//;
if (defined($hash{'ids_'.$idsuri})) {	if (defined($hash{'ids_'.$idsuri})) {
Line 278 sub parse_resource {	Line 509 sub parse_resource {
$hash{'ids_'.$idsuri}=''.$rid;	$hash{'ids_'.$idsuri}=''.$rid;
}	}

if ($turi=~/\/(syllabus\|aboutme\|navmaps\|smppg\|bulletinboard)$/) {

	if ($turi=~/\/(syllabus\|aboutme\|navmaps\|smppg\|bulletinboard\|viewclasslist)$/) {
$turi.='?register=1';	$turi.='?register=1';
}	}


	# resource id lookup: 'src'_resourc-di => URI decorated with a query
	# parameter as above if necessary due to the resource type.

$hash{'src_'.$rid}=$turi;	$hash{'src_'.$rid}=$turi;

	# Mark the external-ness of the resource:

if ($token->[2]->{'external'} eq 'true') {	if ($token->[2]->{'external'} eq 'true') {
$hash{'ext_'.$rid}='true:';	$hash{'ext_'.$rid}='true:';
} else {	} else {
$hash{'ext_'.$rid}='false:';	$hash{'ext_'.$rid}='false:';
}	}

	# If the resource is a start/finish resource set those
	# entries in the has so that navigation knows where everything starts.
	# TODO? If there is a malformed sequence that has no start or no finish
	# resource, should this be detected and errors thrown? How would such a
	# resource come into being other than being manually constructed by a person
	# and then uploaded? Could that happen if an author decided a sequence was almost
	# right edited it by hand and then reuploaded it to 'fix it' but accidently cut the
	# start or finish resources?
	#
	# All resourcess also get a type_id => (start \| finish \| normal) hash entr.
	#
if ($token->[2]->{'type'}) {	if ($token->[2]->{'type'}) {
$hash{'type_'.$rid}=$token->[2]->{'type'};	$hash{'type_'.$rid}=$token->[2]->{'type'};
if ($token->[2]->{'type'} eq 'start') {	if ($token->[2]->{'type'} eq 'start') {
Line 300 sub parse_resource {	Line 551 sub parse_resource {
} else {	} else {
$hash{'type_'.$rid}='normal';	$hash{'type_'.$rid}='normal';
}	}

	# Sequences end pages are constructed entities. They require that the
	# map that defines _them_ be loaded as well into the hash...with this resourcde
	# as the base of the nesting.
	# Resources like that are also marked with is_map_id => 1 entries.
	#

if (($turi=~/\.sequence$/) \|\|	if (($turi=~/\.sequence$/) \|\|
($turi=~/\.page$/)) {	($turi=~/\.page$/)) {
$hash{'is_map_'.$rid}=1;	$hash{'is_map_'.$rid}=1;
&loadmap($turi,$rid);	&loadmap($turi,$rid,$courseid);
}	}
return $token->[2]->{'id'};	return $token->[2]->{'id'};
}	}

	#-------------------------------------------------------------------- link
	# Links define how you are allowed to move from one resource to another.
	# They are the transition edges in the directed graph that a map is.
	# This sub takes informatino from a <link> tag and constructs the
	# navigation bits and pieces of a map. There is no requirement that the
	# resources that are linke are already defined, however clearly the map is
	# badly broken if they are not _eventually_ defined.
	#
	# Note that links can be unconditional or conditional.
	#
	# Parameters:
	# linkpc - The link counter for this level of map nesting (this is
	# reset to zero by loadmap prior to starting to process
	# links for map).
	# lpc - The map level ocounter (how deeply nested this map is in
	# the hierarchy of maps that are recursively read in.
	# to - resource id (within the XML) of the target of the edge.
	# from - resource id (within the XML) of the source of the edge.
	# condition- id of condition associated with the edge (also within the XML).
	#

sub make_link {	sub make_link {
my ($linkpc,$lpc,$to,$from,$condition) = @_;	my ($linkpc,$lpc,$to,$from,$condition) = @_;

	# Compute fully qualified ids for the link, the
	# and from/to by prepending lpc.
	#

my $linkid=$lpc.'.'.$linkpc;	my $linkid=$lpc.'.'.$linkpc;
my $goesto=$lpc.'.'.$to;	my $goesto=$lpc.'.'.$to;
my $comesfrom=$lpc.'.'.$from;	my $comesfrom=$lpc.'.'.$from;
my $undercond=0;	my $undercond=0;


	# If there is a condition, qualify it with the level counter.

if ($condition) {	if ($condition) {
$undercond=$lpc.'.'.$condition;	$undercond=$lpc.'.'.$condition;
}	}

	# Links are represnted by:
	# goesto_.fuullyqualifedlinkid => fully qualified to
	# comesfrom.fullyqualifiedlinkid => fully qualified from
	# undercond_.fullyqualifiedlinkid => fully qualified condition id.

$hash{'goesto_'.$linkid}=$goesto;	$hash{'goesto_'.$linkid}=$goesto;
$hash{'comesfrom_'.$linkid}=$comesfrom;	$hash{'comesfrom_'.$linkid}=$comesfrom;
$hash{'undercond_'.$linkid}=$undercond;	$hash{'undercond_'.$linkid}=$undercond;

	# In addition:
	# to_.fully qualified from => comma separated list of
	# link ids with that from.
	# Similarly:
	# from_.fully qualified to => comma separated list of link ids`
	# with that to.
	# That allows us given a resource id to know all edges that go to it
	# and leave from it.
	#

if (defined($hash{'to_'.$comesfrom})) {	if (defined($hash{'to_'.$comesfrom})) {
$hash{'to_'.$comesfrom}.=','.$linkid;	$hash{'to_'.$comesfrom}.=','.$linkid;
} else {	} else {
Line 338 sub make_link {	Line 638 sub make_link {
}	}

# ------------------------------------------------------------------- Condition	# ------------------------------------------------------------------- Condition
	#
	# Processes <condition> tags, storing sufficient information about them
	# in the hash so that they can be evaluated and used to conditionalize
	# what is presented to the student.
	#
	# these can have the following attributes
	#
	# id = A unique identifier of the condition within the map.
	#
	# value = Is a perl script-let that, when evaluated in safe space
	# determines whether or not the condition is true.
	# Normally this takes the form of a test on an Apache::lonnet::EXT call
	# to find the value of variable associated with a resource in the
	# map identified by a mapalias.
	# Here's a fragment of XML code that illustrates this:
	#
	# <param to="5" value="mainproblem" name="parameter_0_mapalias" type="string" />
	# <resource src="" id="1" type="start" title="Start" />
	# <resource src="/res/msu/albertel/b_and_c/p1.problem" id="5" title="p1.problem" />
	# <condition value="&EXT('user.resource.resource.0.tries','mainproblem')
	# <2 " id="61" type="stop" />
	# <link to="5" index="1" from="1" condition="61" />
	#
	# In this fragment:
	# - The param tag establishes an alias to resource id 5 of 'mainproblem'.
	# - The resource that is the start of the map is identified.
	# - The resource tag identifies the resource associated with this tag
	# and gives it the id 5.
	# - The condition is true if the tries variable associated with mainproblem
	# is less than 2 (that is the user has had more than 2 tries).
	# The condition type is a stop condition which inhibits(?) the associated
	# link if the condition is false.
	# - The link to resource 5 from resource 1 is affected by this condition.
	#
	# type = Type of the condition. The type determines how the condition affects the
	# link associated with it and is one of
	# - 'force'
	# - 'stop'
	# anything else including not supplied..which treated as:
	# - 'normal'.
	# Presumably maps get created by the resource assembly tool and therefore
	# illegal type values won't squirm their way into the XML.
	#
	# Side effects:
	# - The kind_level-qualified-condition-id hash element is set to 'cond'.
	# - The condition text is pushed into the cond array and its element number is
	# set in the condid_level-qualified-condition-id element of the hash.
	# - The condition type is colon appneded to the cond array element for this condition.
sub parse_condition {	sub parse_condition {
my ($token,$lpc) = @_;	my ($token,$lpc) = @_;
my $rid=$lpc.'.'.$token->[2]->{'id'};	my $rid=$lpc.'.'.$token->[2]->{'id'};
Line 356 sub parse_condition {	Line 704 sub parse_condition {
}	}

# ------------------------------------------------------------------- Parameter	# ------------------------------------------------------------------- Parameter
	# Parse a <parameter> 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 of parameter (e.g. parameter_randompick or parameter_randomorder).
	# value=xxx - value of the parameter.

sub parse_param {	sub parse_param {
my ($token,$lpc) = @_;	my ($token,$lpc) = @_;
my $referid=$lpc.'.'.$token->[2]->{'to'};	my $referid=$lpc.'.'.$token->[2]->{'to'}; # Resource param applies to.
my $name=$token->[2]->{'name'};	my $name=$token->[2]->{'name'}; # Name of parameter
my $part;	my $part;
if ($name=~/^parameter_(.*)_/) {

	if ($name=~/^parameter_(.*)_/) {
$part=$1;	$part=$1;
} else {	} else {
$part=0;	$part=0;
}	}

	# Peel the parameter_ off the parameter name.

$name=~s/^._([^_])$/$1/;	$name=~s/^._([^_])$/$1/;

	# The value is:
	# type.part.name.value

my $newparam=	my $newparam=
&escape($token->[2]->{'type'}).':'.	&escape($token->[2]->{'type'}).':'.
&escape($part.'.'.$name).'='.	&escape($part.'.'.$name).'='.
&escape($token->[2]->{'value'});	&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})) {	if (defined($hash{'param_'.$referid})) {
$hash{'param_'.$referid}.='&'.$newparam;	$hash{'param_'.$referid}.='&'.$newparam;
} else {	} else {
$hash{'param_'.$referid}=''.$newparam;	$hash{'param_'.$referid}=''.$newparam;
}	}
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'};	$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'};	$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'};	$randomorder{$referid}=$token->[2]->{'value'};
}	}

	# 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]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
if ($token->[2]->{'value'}=~/^yes$/i) {	if ($token->[2]->{'value'}=~/^yes$/i) {
$encurl{$referid}=1;	$encurl{$referid}=1;
Line 397 sub parse_param {	Line 786 sub parse_param {
}	}
}	}
}	}
	#
	# Parse mapalias parameters.
	# these are tags of the form:
	# <param to="nn"
	# value="some-alias-for-resourceid-nn"
	# name="parameter_0_mapalias"
	# type="string" />
	# A map alias is a textual name for a resource:
	# - The to attribute identifies the resource (this gets level qualified below)
	# - The value attributes provides the alias string.
	# - name must be of the regexp form: /^parameter_(0_)*mapalias$/
	# - e.g. the string 'parameter_' followed by 0 or more "0_" strings
	# terminating with the string 'mapalias'.
	# Examples:
	# 'parameter_mapalias', 'parameter_0_mapalias', parameter_0_0_mapalias'
	# Invalid to ids are silently ignored.
	#
	# Parameters:
	# token - The token array fromthe HMTML::TokeParser
	# lpc - The current map level counter.
	#
sub parse_mapalias_param {	sub parse_mapalias_param {
my ($token,$lpc) = @_;	my ($token,$lpc) = @_;

	# Fully qualify the to value and ignore the alias if there is no
	# corresponding resource.

my $referid=$lpc.'.'.$token->[2]->{'to'};	my $referid=$lpc.'.'.$token->[2]->{'to'};
return if (!exists($hash{'src_'.$referid}));	return if (!exists($hash{'src_'.$referid}));

	# If this is a valid mapalias parameter,
	# Append the target id to the count_mapalias element for that
	# alias so that we can detect doubly defined aliases
	# e.g.:
	# <param to="1" value="george" name="parameter_0_mapalias" type="string" />
	# <param to="2" value="george" name="parameter_0_mapalias" type="string" />
	#
	# The example above is trivial but the case that's important has to do with
	# constructing a map that includes a nested map where the nested map may have
	# aliases that conflict with aliases established in the enclosing map.
	#
	# ...and create/update the hash mapalias entry to actually store the alias.
	#

if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {	if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
&count_mapalias($token->[2]->{'value'},$referid);	&count_mapalias($token->[2]->{'value'},$referid);
$hash{'mapalias_'.$token->[2]->{'value'}}=$referid;	$hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
Line 411 sub parse_mapalias_param {	Line 838 sub parse_mapalias_param {

# --------------------------------------------------------- Simplify expression	# --------------------------------------------------------- Simplify expression


	#
	# Someone should really comment this to describe what it does to what and why.
	#
sub simplify {	sub simplify {
my $expression=shift;	my $expression=shift;
# (0&1) = 1	# (0&1) = 1
Line 420 sub simplify {	Line 851 sub simplify {
# 8&8=8	# 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	# 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	# (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))	# (((5&3)\|(4&6)))=((5&3)\|(4&6))
Line 434 sub simplify {	Line 865 sub simplify {

# -------------------------------------------------------- Build condition hash	# -------------------------------------------------------- Build condition hash

	#
	# Traces a route recursively through the map after it has been loaded
	# (I believe this really visits each resourcde that is reachable fromt he
	# start top node.
	#
	# - Marks hidden resources as hidden.
	# - Marks which resource URL's must be encrypted.
	# - Figures out (if necessary) the first resource in the map.
	# - Further builds the chunks of the big hash that define how
	# conditions work
	#
	# Note that the tracing strategy won't visit resources that are not linked to
	# anything or islands in the map (groups of resources that form a path but are not
	# linked in to the path that can be traced from the start resource...but that's ok
	# because by definition, those resources are not reachable by users of the course.
	#
	# Parameters:
	# sofar - _URI of the prior entry or 0 if this is the top.
	# rid - URI of the resource to visit.
	# beenhere - list of resources (each resource enclosed by &'s) that have
	# already been visited.
	# encflag - If true the resource that resulted in a recursive call to us
	# has an encoded URL (which means contained resources should too).
	# hdnflag - If true,the resource that resulted in a recursive call to us
	# was hidden (which means contained resources should be hidden too).
	# Returns
	# new value indicating how far the map has been traversed (the sofar).
	#
sub traceroute {	sub traceroute {
my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;	my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
my $newsofar=$sofar=simplify($sofar);	my $newsofar=$sofar=simplify($sofar);

unless ($beenhere=~/\&\Q$rid\E\&/) {	unless ($beenhere=~/\&\Q$rid\E\&/) {
$beenhere.=$rid.'&';	$beenhere.=$rid.'&';
my ($mapid,$resid)=split(/\./,$rid);	my ($mapid,$resid)=split(/\./,$rid);
Line 452 sub traceroute {	Line 912 sub traceroute {

my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);	my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
if ($encflag \|\| lc($encrypt) eq 'yes') { $encurl{$rid}=1; }	if ($encflag \|\| lc($encrypt) eq 'yes') { $encurl{$rid}=1; }

if (($retfrid eq '') && ($hash{'src_'.$rid})	if (($retfrid eq '') && ($hash{'src_'.$rid})
&& ($hash{'src_'.$rid}!~/\.sequence$/)) {	&& ($hash{'src_'.$rid}!~/\.sequence$/)) {
$retfrid=$rid;	$retfrid=$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 465 sub traceroute {	Line 927 sub traceroute {

# if the expression is just the 0th condition keep it	# if the expression is just the 0th condition keep it
# otherwise leave a pointer to this condition expression	# otherwise leave a pointer to this condition expression

$newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;	$newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;

	# Recurse if the resource is a map:

if (defined($hash{'is_map_'.$rid})) {	if (defined($hash{'is_map_'.$rid})) {
if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {	if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
$sofar=$newsofar=	$sofar=$newsofar=
Line 477 sub traceroute {	Line 942 sub traceroute {
$hdnflag \|\| $hiddenurl{$rid});	$hdnflag \|\| $hiddenurl{$rid});
}	}
}	}

	# Processes links to this resource:
	# - verify the existence of any conditionals on the link to here.
	# - Recurse to any resources linked to us.
	#
if (defined($hash{'to_'.$rid})) {	if (defined($hash{'to_'.$rid})) {
foreach my $id (split(/\,/,$hash{'to_'.$rid})) {	foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
my $further=$sofar;	my $further=$sofar;
	#
	# If there's a condition associated with this link be sure
	# it's been defined else that's an error:
	#
if ($hash{'undercond_'.$id}) {	if ($hash{'undercond_'.$id}) {
if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {	if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {
$further=simplify('('.'_'.$rid.')&('.	$further=simplify('('.'_'.$rid.')&('.
$hash{'condid_'.$hash{'undercond_'.$id}}.')');	$hash{'condid_'.$hash{'undercond_'.$id}}.')');
} else {	} else {
$errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id});	$errtext.= '<br />'.
	&mt('Undefined condition ID: [_1]',
	$hash{'undercond_'.$id});
}	}
}	}
	# Recurse to resoruces that have to's to us.
$newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,	$newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,
$encflag,$hdnflag);	$encflag,$hdnflag);
}	}
Line 498 sub traceroute {	Line 975 sub traceroute {

# ------------------------------ Cascading conditions, quick access, parameters	# ------------------------------ Cascading conditions, quick access, parameters

	#
	# Seems a rather strangely named sub given what the comment above says it does.


sub accinit {	sub accinit {
my ($uri,$short,$fn)=@_;	my ($uri,$short,$fn)=@_;
my %acchash=();	my %acchash=();
my %captured=();	my %captured=();
my $condcounter=0;	my $condcounter=0;
$acchash{'acc.cond.'.$short.'.0'}=0;	$acchash{'acc.cond.'.$short.'.0'}=0;

	# This loop is only interested in conditions and
	# parameters in the big hash:

foreach my $key (keys(%hash)) {	foreach my $key (keys(%hash)) {

	# conditions:

if ($key=~/^conditions/) {	if ($key=~/^conditions/) {
my $expr=$hash{$key};	my $expr=$hash{$key};

# try to find and factor out common sub-expressions	# try to find and factor out common sub-expressions
	# Any subexpression that is found is simplified, removed from
	# the original condition expression and the simplified sub-expression
	# substituted back in to the epxression..I'm not actually convinced this
	# factors anything out...but instead maybe simplifies common factors(?)

foreach my $sub ($expr=~m/($\([_\.\d]+(?:\&[_\.\d]+)+$(?:\\|$[_\.\d]+(?:\&[_\.\d]+)+$)+\))/g) {	foreach my $sub ($expr=~m/($\([_\.\d]+(?:\&[_\.\d]+)+$(?:\\|$[_\.\d]+(?:\&[_\.\d]+)+$)+\))/g) {
my $orig=$sub;	my $orig=$sub;

Line 521 sub accinit {	Line 1015 sub accinit {
$expr=~s/\Q$orig\E/$sub/;	$expr=~s/\Q$orig\E/$sub/;
}	}
$hash{$key}=$expr;	$hash{$key}=$expr;

	# If not yet seen, record in acchash and that we've seen it.

unless (defined($captured{$expr})) {	unless (defined($captured{$expr})) {
$condcounter++;	$condcounter++;
$captured{$expr}=$condcounter;	$captured{$expr}=$condcounter;
$acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;	$acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
}	}
	# Parameters:

} elsif ($key=~/^param_(\d+)\.(\d+)/) {	} elsif ($key=~/^param_(\d+)\.(\d+)/) {
my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,	my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,
$hash{'src_'.$1.'.'.$2});	$hash{'src_'.$1.'.'.$2});
Line 539 sub accinit {	Line 1038 sub accinit {
}	}
}	}
}	}
	# This loop only processes id entries in the big hash.

foreach my $key (keys(%hash)) {	foreach my $key (keys(%hash)) {
if ($key=~/^ids/) {	if ($key=~/^ids/) {
foreach my $resid (split(/\,/,$hash{$key})) {	foreach my $resid (split(/\,/,$hash{$key})) {
Line 582 sub accinit {	Line 1083 sub accinit {

sub hiddenurls {	sub hiddenurls {
my $randomoutentry='';	my $randomoutentry='';
foreach my $rid (keys %randompick) {	foreach my $rid (keys(%randompick)) {
my $rndpick=$randompick{$rid};	my $rndpick=$randompick{$rid};
my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};	my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
# ------------------------------------------- put existing resources into array	# ------------------------------------------- put existing resources into array
Line 603 sub hiddenurls {	Line 1104 sub hiddenurls {
# -------------------------------- randomly eliminate the ones that should stay	# -------------------------------- randomly eliminate the ones that should stay
my (undef,$id)=split(/\./,$rid);	my (undef,$id)=split(/\./,$rid);
if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }	if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }
	my $setcode;
	if (defined($randomizationcode{$rid})) {
	if ($env{'form.CODE'} eq '') {
	$env{'form.CODE'} = $randomizationcode{$rid};
	$setcode = 1;
	}
	}
my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb	my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb
	if ($setcode) {
	undef($env{'form.CODE'});
	undef($setcode);
	}
&Apache::lonnet::setup_random_from_rndseed($rndseed);	&Apache::lonnet::setup_random_from_rndseed($rndseed);
my @whichids=&Math::Random::random_permuted_index($#currentrids+1);	my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }	for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
Line 613 sub hiddenurls {	Line 1125 sub hiddenurls {
if ($currentrids[$k]) {	if ($currentrids[$k]) {
$hash{'randomout_'.$currentrids[$k]}=1;	$hash{'randomout_'.$currentrids[$k]}=1;
my ($mapid,$resid)=split(/\./,$currentrids[$k]);	my ($mapid,$resid)=split(/\./,$currentrids[$k]);
	if ($rescount{$mapid}) {
	$rescount{$mapid} --;
	}
	if ($hash{'is_map_'.$currentrids[$k]}) {
	if ($mapcount{$mapid}) {
	$mapcount{$mapid} --;
	}
	}
$randomoutentry.='&'.	$randomoutentry.='&'.
&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},	&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
$resid,	$resid,
Line 622 sub hiddenurls {	Line 1142 sub hiddenurls {
}	}
}	}
# ------------------------------ take care of explicitly hidden urls or folders	# ------------------------------ take care of explicitly hidden urls or folders
foreach my $rid (keys %hiddenurl) {	foreach my $rid (keys(%hiddenurl)) {
$hash{'randomout_'.$rid}=1;	$hash{'randomout_'.$rid}=1;
my ($mapid,$resid)=split(/\./,$rid);	my ($mapid,$resid)=split(/\./,$rid);
	if ($rescount{$mapid}) {
	$rescount{$mapid} --;
	}
	if ($hash{'is_map_'.$rid}) {
	if ($mapcount{$mapid}) {
	$mapcount{$mapid} --;
	}
	}
$randomoutentry.='&'.	$randomoutentry.='&'.
&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,	&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
$hash{'src_'.$rid}).'&';	$hash{'src_'.$rid}).'&';
Line 635 sub hiddenurls {	Line 1163 sub hiddenurls {
}	}
}	}

	# -------------------------------------- populate big hash with map breadcrumbs

	# Create map_breadcrumbs_$pc from map_hierarchy_$pc by omitting intermediate
	# maps not shown in Course Contents table.

	sub mapcrumbs {
	foreach my $key (keys(%rescount)) {
	if ($hash{'map_hierarchy_'.$key}) {
	my $skipnext = 0;
	foreach my $id (split(/,/,$hash{'map_hierarchy_'.$key}),$key) {
	unless ($skipnext) {
	$hash{'map_breadcrumbs_'.$key} .= "$id,";
	}
	unless (($id == 0) \|\| ($id == 1)) {
	if ((!$rescount{$id}) \|\| ($rescount{$id} == 1 && $mapcount{$id} == 1)) {
	$skipnext = 1;
	} else {
	$skipnext = 0;
	}
	}
	}
	$hash{'map_breadcrumbs_'.$key} =~ s/,$//;
	}
	}
	}

# ---------------------------------------------------- Read map and all submaps	# ---------------------------------------------------- Read map and all submaps

sub readmap {	sub readmap {
my $short=shift;	my $short=shift;
$short=~s/^\///;	$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 $fn=$cenv{'fn'};
my $uri;	my $uri;
$short=~s/\//\_/g;	$short=~s/\//\_/g;
unless ($uri=$cenv{'url'}) {	unless ($uri=$cenv{'url'}) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
"Could not load course $short.</font>");	"Could not load course $short.</font>");
return ('',&mt('No course data available.'));;	return ('',&mt('No course data available.'));;
}	}
@cond=('true:normal');	@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.
	#
	$retfurl = '';
	return ($retfurl,'<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.');
	}
my $lock=0;	my $lock=0;
my $gotstate=0;	my $gotstate=0;
if (flock(LOCKFILE,LOCK_EX\|LOCK_NB)) {
$lock=1;	# 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);	&unlink_tmpfiles($fn);
}	}
undef %randompick;	undef %randompick;
undef %hiddenurl;	undef %hiddenurl;
undef %encurl;	undef %encurl;
$retfrid='';	$retfrid='';
my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash);	$errtext='';
	my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.

	# if we got the lock, regenerate course regnerate empty files and tie them.

if ($lock) {	if ($lock) {
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {	if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
$tiedhash = 1;	$tiedhash = 1;
if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {	if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
$tiedparmhash = 1;	$tiedparmhash = 1;
$gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv);	$gotstate = &build_tmp_hashes($uri,
	$fn,
	$short,
	\%cenv); # TODO: Need to provide requested user@dom
unless ($gotstate) {	unless ($gotstate) {
&Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');	&Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');
}	}
Line 684 sub readmap {	Line 1259 sub readmap {
'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');	'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
}	}
}	}
flock(LOCKFILE,LOCK_UN);	flock(LOCKFILE,LOCK_UN); # RF: this is what I don't get unless there are other
close(LOCKFILE);	# 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) {	unless ($lock && $tiedhash && $tiedparmhash) {
# if we are here it is likely because we are already trying to	# if we are here it is likely because we are already trying to
Line 693 sub readmap {	Line 1270 sub readmap {
# tie the hashes for the next 90 seconds, if we succeed forward	# 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	# them on to navmaps, if we fail, throw up the Could not init
# course screen	# 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) {	if ($lock) {
# Got the lock but not the DB files	# Got the lock but not the DB files
flock(LOCKFILE,LOCK_UN);	flock(LOCKFILE,LOCK_UN);
Line 708 sub readmap {	Line 1292 sub readmap {
untie(%parmhash);	untie(%parmhash);
}	}
}	}
&Apache::lonnet::logthis("<font color=blue>WARNING: ".	# Log our failure:

	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
"Could not tie coursemap $fn for $uri.</font>");	"Could not tie coursemap $fn for $uri.</font>");
$tiedhash = '';	$tiedhash = '';
$tiedparmhash = '';	$tiedparmhash = '';
my $i=0;	my $i=0;

	# Keep on retrying the lock for 90 sec until we succeed.

while($i<90) {	while($i<90) {
$i++;	$i++;
sleep(1);	sleep(1);
if (flock(LOCKFILE,LOCK_EX\|LOCK_NB)) {	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;	$lock = 1;
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {	if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
$tiedhash = 1;	$tiedhash = 1;
Line 724 sub readmap {	Line 1318 sub readmap {
$tiedparmhash = 1;	$tiedparmhash = 1;
if (-e "$fn.state") {	if (-e "$fn.state") {
$retfurl='/adm/navmaps';	$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,	&Apache::lonnet::appenv({"request.course.id" => $short,
"request.course.fn" => $fn,	"request.course.fn" => $fn,
"request.course.uri" => $uri});	"request.course.uri" => $uri,
	"request.course.tied" => time});

$untiedhash = untie(%hash);	$untiedhash = untie(%hash);
$untiedparmhash = untie(%parmhash);	$untiedparmhash = untie(%parmhash);
$gotstate = 1;	$gotstate = 1;
Line 740 sub readmap {	Line 1341 sub readmap {
}	}
if ($lock) {	if ($lock) {
flock(LOCKFILE,LOCK_UN);	flock(LOCKFILE,LOCK_UN);
	$lock = 0;
if ($tiedparmhash) {	if ($tiedparmhash) {
unless ($untiedparmhash) {	unless ($untiedparmhash) {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
Line 754 sub readmap {	Line 1356 sub readmap {
}	}
}	}
}	}
	# 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) {	unless ($gotstate) {
	$lock = 0;
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not read statemap '.$fn.' for '.$uri.'.</font>');	'Could not read statemap '.$fn.' for '.$uri.'.</font>');
&unlink_tmpfiles($fn);	&unlink_tmpfiles($fn);
if (open(LOCKFILE,">$fn.db.lock")) {	if (flock(LOCKFILE,LOCK_EX\|LOCK_NB)) {
my $lock=0;	$lock=1;
if (flock(LOCKFILE,LOCK_EX\|LOCK_NB)) {	}
$lock=1;	undef %randompick;
&unlink_tmpfiles($fn);	undef %hiddenurl;
}	undef %encurl;
undef %randompick;	$errtext='';
undef %hiddenurl;	$retfrid='';
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 ($lock) {
if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {	if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
$gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv);	if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
unless ($gotstate) {	$gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv); # TODO: User dependent?
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	unless ($gotstate) {
'Failed to write statemap at second attempt '.$fn.' for '.$uri.'.</font>');
}
unless (untie(%parmhash)) {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not untie coursemap parmhash '.$fn.'.db for '.$uri.'.</font>');
}
} else {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not tie coursemap '.$fn.'__parms.db for '.$uri.'.</font>');	'Failed to write statemap at second attempt '.$fn.' for '.$uri.'.</font>');
}	}
unless (untie(%hash)) {	unless (untie(%parmhash)) {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not untie coursemap hash '.$fn.'.db for '.$uri.'.</font>');	'Could not untie coursemap parmhash '.$fn.'.db for '.$uri.'.</font>');
}	}
} else {	} else {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not tie coursemap '.$fn.'.db for '.$uri.'.</font>');	'Could not tie coursemap '.$fn.'__parms.db for '.$uri.'.</font>');
}	}
flock(LOCKFILE,LOCK_UN);	unless (untie(%hash)) {
close(LOCKFILE);	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
	'Could not untie coursemap hash '.$fn.'.db for '.$uri.'.</font>');
	}
} else {	} else {
&Apache::lonnet::logthis('<font color="blue">WARNING: '.	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
'Could not obtain lock to tie coursemap hash '.$fn.'.db for '.$uri.'.</font>');	'Could not tie coursemap '.$fn.'.db for '.$uri.'.</font>');
}	}
close(LOCKFILE);	flock(LOCKFILE,LOCK_UN);
	$lock = 0;
	} else {
	# Failed to get the immediate lock.

	&Apache::lonnet::logthis('<font color="blue">WARNING: '.
	'Could not obtain lock to tie coursemap hash '.$fn.'.db for '.$uri.'.</font>');
}	}
}	}
	close(LOCKFILE);
unless (($errtext eq '') \|\| ($env{'request.course.uri'} =~ m{^/uploaded/})) {	unless (($errtext eq '') \|\| ($env{'request.course.uri'} =~ m{^/uploaded/})) {
&Apache::lonmsg::author_res_msg($env{'request.course.uri'},	&Apache::lonmsg::author_res_msg($env{'request.course.uri'},
$errtext);	$errtext); # TODO: User dependent?
}	}
# ------------------------------------------------- Check for critical messages	# ------------------------------------------------- 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'},	my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
$env{'user.name'});	$env{'user.name'});
if ($what[0]) {	if ($what[0]) {
Line 817 sub readmap {	Line 1430 sub readmap {
return ($retfurl,$errtext);	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 {	sub build_tmp_hashes {
my ($uri,$fn,$short,$cenvref) = @_;	my ($uri,$fn,$short,$cenvref) = @_;

unless(ref($cenvref) eq 'HASH') {	unless(ref($cenvref) eq 'HASH') {
return;	return;
}	}
my %cenv = %{$cenvref};	my %cenv = %{$cenvref};
my $gotstate = 0;	my $gotstate = 0;
%hash=();	%hash=(); # empty the global course and parameter hashes.
%parmhash=();	%parmhash=();
$errtext='';	$errtext=''; # No error messages yet.
$pc=0;	$pc=0;
&clear_mapalias_count();	&clear_mapalias_count();
&processversionfile(%cenv);	&processversionfile(%cenv);

	# URI Of the map file.

my $furi=&Apache::lonnet::clutter($uri);	my $furi=&Apache::lonnet::clutter($uri);
	#
	# the map staring points.
	#
$hash{'src_0.0'}=&versiontrack($furi);	$hash{'src_0.0'}=&versiontrack($furi);
$hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');	$hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
$hash{'ids_'.$furi}='0.0';	$hash{'ids_'.$furi}='0.0';
$hash{'is_map_0.0'}=1;	$hash{'is_map_0.0'}=1;
&loadmap($uri,'0.0');
	# Load the map.. note that loadmap may implicitly recurse if the map contains
	# sub-maps.


	&loadmap($uri,'0.0',$short);

	# The code below only executes if there is a starting point for the map>
	# Q/BUG??? If there is no start resource for the map should that be an error?
	#

if (defined($hash{'map_start_'.$uri})) {	if (defined($hash{'map_start_'.$uri})) {
&Apache::lonnet::appenv({"request.course.id" => $short,	&Apache::lonnet::appenv({"request.course.id" => $short,
"request.course.fn" => $fn,	"request.course.fn" => $fn,
"request.course.uri" => $uri});	"request.course.uri" => $uri,
	"request.course.tied" => time});
$env{'request.course.id'}=$short;	$env{'request.course.id'}=$short;
&traceroute('0',$hash{'map_start_'.$uri},'&');	&traceroute('0',$hash{'map_start_'.$uri},'&');
&accinit($uri,$short,$fn);	&accinit($uri,$short,$fn);
&hiddenurls();	&hiddenurls();
	&mapcrumbs();
}	}
$errtext .= &get_mapalias_errors();	$errtext .= &get_mapalias_errors();
# ------------------------------------------------------- Put versions into src	# ------------------------------------------------------- Put versions into src
Line 888 sub build_tmp_hashes {	Line 1535 sub build_tmp_hashes {

sub unlink_tmpfiles {	sub unlink_tmpfiles {
my ($fn) = @_;	my ($fn) = @_;
if ($fn =~ m{^\Q$Apache::lonnet::perlvar{'lonUsersDir'}\E/tmp/}) {	my $file_dir = dirname($fn);

	if ("$file_dir/" eq LONCAPA::tempdir()) {
my @files = qw (.db _symb.db .state _parms.db);	my @files = qw (.db _symb.db .state _parms.db);
foreach my $file (@files) {	foreach my $file (@files) {
if (-e $fn.$file) {	if (-e $fn.$file) {
Line 942 sub evalstate {	Line 1591 sub evalstate {
return $state;	return $state;
}	}

	# This block seems to have code to manage/detect doubly defined
	# aliases in maps.

{	{
my %mapalias_cache;	my %mapalias_cache;
sub count_mapalias {	sub count_mapalias {
Line 962 sub evalstate {	Line 1614 sub evalstate {
$count++;	$count++;
}	}
my ($mapid) = split(/\./,$id);	my ($mapid) = split(/\./,$id);
&mt('Resource "[_1]" <br /> in Map "[_2]"',	&mt('Resource [_1][_2]in Map [_3]',
$hash{'title_'.$id},	$hash{'title_'.$id},'<br />',
$hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});	$hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
} (@{ $mapalias_cache{$mapalias} }));	} (@{ $mapalias_cache{$mapalias} }));
next if ($count < 2);	next if ($count < 2);

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.132
changed lines
	Added in v.1.153