--- rat/lonuserstate.pm 2010/06/16 23:42:52 1.136 +++ rat/lonuserstate.pm 2022/10/04 20:39:57 1.169 @@ -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.136 2010/06/16 23:42:52 raeburn Exp $ +# $Id: lonuserstate.pm,v 1.169 2022/10/04 20:39:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,12 +42,14 @@ use Safe::Hole; use Opcode; use Apache::lonenc; use Fcntl qw(:flock); -use LONCAPA; +use LONCAPA qw(:DEFAULT :match); +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 @@ -57,8 +59,12 @@ my $retfurl; # first URL my %randompick; # randomly picked resources my %randompickseed; # optional seed for randomly picking resources 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 %hiddenurl; # this URL (or complete folder) is supposed to be hidden +my %deeplinkout; # this URL (or complete folder) unavailable in deep-link session +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 @@ -68,6 +74,21 @@ sub versionerror { $uri,$usedversion,$unusedversion).'
'; } +# 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 { my $uri=shift; if ($uri=~/\.(\d+)\.\w+$/) { @@ -112,20 +133,41 @@ 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 { - my ($uri,$parent_rid)=@_; + my ($uri,$parent_rid,$courseid)=@_; + + # 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.''). '

'; 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; + + # 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})) { @@ -136,36 +178,57 @@ sub loadmap { } } -# Determine and check filename +# 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$/)) { - $errtext.=&mt("
Invalid map: [_1]",$fn); + # 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) { - $errtext.=&mt('
Map not loaded: The file [_1] does not exist.',$fn); + $errtext.= '
' + .&mt('Map not loaded: The file [_1] does not exist.', + "$fn"); + $hash{'map_type_'.$lpc}='none'; + if (&is_advanced($courseid)) { + $errtext .= &error_detail($parent_rid,$courseid,$ispage,$uri); + } 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); @@ -177,27 +240,76 @@ 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; + my $codechecked; + $rescount{$lpc} = 0; + $mapcount{$lpc} = 0; 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,$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) { -# ----------------------------------------------------------------------- Links &make_link(++$linkpc,$lpc,$token->[2]->{'to'}, $token->[2]->{'from'}, - $token->[2]->{'condition'}); + $token->[2]->{'condition'}); # note ..condition may be undefined. + + # condition + } elsif ($token->[1] eq 'condition' && !$randomize) { &parse_condition($token,$lpc); } } + undef($codechecked); + + # Handle randomization and random selection if ($randomize) { - if (!$env{'request.role.adv'}) { + unless (&is_advanced($courseid)) { + # Order of resources is not randomized if user has and advanced role in the course. 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})) { $seed = $randompickseed{$parent_rid}; } else { + + # Otherwise the parent's fully encoded symb is used. + my ($mapid,$resid)=split(/\./,$parent_rid); my $symb= &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, @@ -205,16 +317,43 @@ sub loadmap { $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); &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); } + my $from = shift(@map_ids); my $from_rid = $lpc.'.'.$from; $hash{'map_start_'.$uri} = $from_rid; $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)) { &make_link(++$linkpc,$lpc,$to,$from); my $to_rid = $lpc.'.'.$to; @@ -229,8 +368,10 @@ sub loadmap { $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 + + # last parse out the mapalias params. These provide mnemonic + # tags to resources that can be used in conditions + while (my $token = $parser->get_token) { next if ($token->[0] ne 'S'); if ($token->[1] eq 'param') { @@ -239,28 +380,336 @@ sub loadmap { } } +sub is_advanced { + my ($courseid) = @_; + 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'} = ''; + } + return $advanced; +} + +sub error_detail { + my ($parent_rid,$courseid,$ispage,$uri) = @_; + my $errinfo; + if ($courseid) { + my $courseurl = &Apache::lonnet::courseid_to_courseurl($courseid); + if ($parent_rid =~ /^(\d+)\.(\d+)$/) { + my ($parent_pc,$parent_id) = ($1,$2); + my ($parent_type,$published,$uploaded,$canedit,$role,$switchserver,$audom,$auname, + $editfile,$filerole,$fileswitch,$audomfile,$aunamefile); + if (($parent_pc eq '0') && ($hash{'map_id_1'} =~ m{^/res/($match_domain)/($match_username)/.+\.(sequence|page)$})) { + ($audomfile,$aunamefile) = ($1,$2); + ($editfile,$filerole,$fileswitch) = &canedit_published($audomfile,$aunamefile); + if ($fileswitch) { + unless ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audomfile)) && + (&Apache::lonnet::will_trust('coaurem',$audomfile,$env{'user.domain'}))) { + undef($editfile); + } + } + $errinfo = &mt('Top level published sequence file is missing.'); + } else { + if ($parent_pc eq '1') { + if ($hash{'map_id_1'} eq "/uploaded$courseurl/default.sequence") { + $uploaded = 1; + if (&Apache::lonnet::allowed('mdc',$courseid)) { + $canedit = 1; + } + $errinfo = &mt('Map is referenced in the top level ([_1]Main Content[_2]) folder.', + '',''); + } elsif ($hash{'map_id_1'} =~ m{^/res/($match_domain)/($match_username)/.+\.(sequence|page)$}) { + ($audom,$auname) = ($1,$2); + ($canedit,$role,$switchserver) = &canedit_published($audom,$auname); + $published = 1; + $errinfo = &mt('Map is referenced in the top level published sequence file.'); + } + } else { + if ($hash{'map_id_'.$parent_pc} =~ m{^\Q/uploaded$courseurl/default_\E\d+\.(sequence|page)$}) { + $uploaded = 1; + if (&Apache::lonnet::allowed('mdc',$courseid)) { + $canedit = 1; + } + } elsif ($hash{'map_id_'.$parent_pc} =~ m{^/res/($match_domain)/($match_username)/.+\.(sequence|page)$}) { + ($audom,$auname) = ($1,$2); + ($canedit,$role,$switchserver) = &canedit_published($audom,$auname); + $published = 1; + } + if (exists($hash{'ids_'.$hash{'map_id_'.$parent_pc}})) { + $parent_type = $hash{'map_type_'.$parent_pc}; + if ($published) { + $errinfo = &mt("Map is referenced in the published $parent_type file: [_1].", + ''.$hash{'map_id_'.$parent_pc}.''); + } else { + my $title = $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$parent_pc}}}; + if ($title ne '') { + my $mapdesc; + if ($parent_type eq 'sequence') { + $mapdesc = 'folder'; + } else { + $mapdesc = 'composite page'; + } + $errinfo = &mt("Map is referenced in the $mapdesc named: [_1].", + ''.$title.''); + } + my @containers = split(/,/,$hash{'map_hierarchy_'.$parent_pc}); + shift(@containers); + my $folderpath; + foreach my $id (@containers) { + my $name; + if ($id == 1) { + $name = &mt('Main Content'); + } elsif ($hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$id}}} ne '') { + $name = $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$id}}}; + } + if ($name ne '') { + $folderpath .= $name.' » '; + } + } + if ($title eq '') { + $folderpath =~ s/\Q » \E$//; + } else { + $folderpath .= $title; + } + if ($folderpath) { + $errinfo .= '
'.&mt('Hierarchy is: [_1]', + ''.$folderpath.''); + } + } + } + } + if ($uri =~ m{^/res/($match_domain)/($match_username)/.+\.(sequence|page)$}) { + ($audomfile,$aunamefile) = ($1,$2); + ($editfile,$filerole,$fileswitch) = &canedit_published($audomfile,$aunamefile); + if ($fileswitch) { + unless ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audomfile)) && + (&Apache::lonnet::will_trust('coaurem',$audomfile,$env{'user.domain'}))) { + undef($editfile); + } + } + } + } + if ($errinfo) { + $errinfo = '
'.$errinfo.'
'; + } + if ($editfile) { + if ($errinfo ne '') { + $errinfo .= '
'; + } + if ($canedit) { + $errinfo .= &mt('One way to rectify this problem is to create and publish the missing file'); + } else { + $errinfo .= &mt('To rectify this problem, create and publish the missing file'); + } + if ($fileswitch) { + my $rolename = &Apache::lonnet::plaintext($filerole); + my $rolecode; + if ($filerole eq 'au') { + $rolecode = 'au./'.$audomfile.'/'; + } else { + $rolecode = $filerole.'./'.$audomfile.'/'.$aunamefile; + } + $errinfo .= '.
'.&mt('You will need to [_1]switch server[_2].', + '',''); + } else { + my $fileurl = $uri; + $fileurl =~s{^/res/}{/priv/}; + $errinfo .= ': '.&mt('Create the missing file').''; + } + } + if ($canedit) { + if ($errinfo ne '') { + $errinfo .= '
'; + } + if ($published) { + my $rolename = &Apache::lonnet::plaintext($role); + my $rolecode; + if ($role eq 'au') { + $rolecode = 'au./'.$audom.'/'; + } else { + $rolecode = $role.'./'.$audom.'/'.$auname; + } + if ($editfile) { + $errinfo .= &mt('Another way is to edit the parent map to remove the reference to the missing file'); + } else { + $errinfo .= &mt('To rectify this problem edit the parent map to remove the reference to the missing file'); + } + if ($switchserver) { + $errinfo .= '.
'; + if ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audom)) && + (&Apache::lonnet::will_trust('coaurem',$audom,$env{'user.domain'}))) { + $errinfo .= &mt('You will need to [_1]switch server[_2].', + '',''); + } else { + $errinfo .= &mt('Session switch required but prohibited.'); + } + } else { + my $mapurl = $hash{'map_id_'.$parent_pc}; + $mapurl =~s{^/res/}{/priv/}; + $errinfo .= ': '.&mt('Edit the map').''; + } + } elsif ($uploaded && $courseid) { + my ($dest,$linktext); + my $crstype = &Apache::loncommon::course_type($courseid); + if ($parent_pc eq '1') { + $dest = '/adm/coursedocs?folderpath='.&escape('default&Main%20Content:::::'); + $linktext = &mt('Edit Folder'); + } elsif ($hash{'ids_'.$hash{'map_id_'.$parent_pc}} =~ /^(\d+)\.(\d+)$/) { + my ($editmap,$editidx) = ($1,$2); + my $symb = &Apache::lonnet::encode_symb($hash{'map_id_'.$editmap}, + $editidx,$hash{'map_id_'.$parent_pc}); + $dest = '/adm/coursedocs?command=directnav&symb='.&escape($symb); + if ($parent_type eq 'sequence') { + $linktext = &mt('Edit Folder'); + } else { + $linktext = &mt('Edit Composite Page'); + } + } else { + $dest = '/adm/coursedocs?folderpath='.&escape('default&Main%20Content:::::'); + $linktext = &mt("Edit $crstype"); + } + if ($editfile) { + $errinfo .= &mt("Another way is to use the $crstype Editor to delete the reference to the missing file"); + } else { + $errinfo .= &mt("To rectify this problem use the $crstype Editor to delete the reference to the missing file"); + } + $errinfo .= ': '.$linktext.''; + } + $errinfo .= '
'; + } + } + } + return $errinfo; +} + +sub canedit_published { + my ($audom,$auname) = @_; + my ($canedit,$role,$switchserver); + my $now = time; + if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'})) { + if (exists($env{"user.role.au./$audom/"})) { + my ($start,$end) = split(/\./,$env{"user.role.au./$audom/"}); + unless (($end && $end < $now) || ($start && $start > $now)) { + $canedit = 1; + $role = 'au'; + } + } + } + unless ($canedit) { + foreach my $possrole ('ca','aa') { + if (exists($env{"user.role.$possrole./$audom/$auname"})) { + my ($end,$start) = split(/\./,$env{"user.role.$possrole./$audom/$auname"}); + unless (($end && $end < time) || ($start && $start > time)) { + $canedit = 1; + $role = $possrole; + last; + } + } + } + } + if ($canedit) { + my $auhome = &Apache::lonnet::homeserver($auname,$audom); + my @ids=&Apache::lonnet::current_machine_ids(); + if (($auhome ne 'no_host') && (!grep(/^\Q$auhome\E$/,@ids))) { + $switchserver = $auhome; + } + } + return ($canedit,$role,$switchserver); +} # -------------------------------------------------------------------- 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 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; } - my $rid=$lpc.'.'.$token->[2]->{'id'}; + my ($token,$lpc,$ispage,$uri,$courseid) = @_; + + # 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{'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'}); if ($token->[2]->{'version'}) { unless ($hash{'version_'.$turi}) { $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'}; $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) { + + + + # 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?). + + if ($ispage) { + if ($token->[2]->{'external'} eq 'true') { # external + $turi=~s{^http\://}{/ext/}; + } + } else { $turi=~/\.(\w+)$/; my $embstyle=&Apache::loncommon::fileembstyle($1); if ($token->[2]->{'external'} eq 'true') { # external @@ -275,6 +724,8 @@ sub parse_resource { } elsif ($turi!~/\.(sequence|page)$/) { $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 my $mapdir=$uri; $mapdir=~s/[^\/]+$//; @@ -286,7 +737,10 @@ 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; $idsuri=~s/\?.+$//; if (defined($hash{'ids_'.$idsuri})) { @@ -295,17 +749,37 @@ sub parse_resource { $hash{'ids_'.$idsuri}=''.$rid; } + + if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) { $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; + + # Mark the external-ness of the resource: if ($token->[2]->{'external'} eq 'true') { $hash{'ext_'.$rid}='true:'; } else { $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'}) { $hash{'type_'.$rid}=$token->[2]->{'type'}; if ($token->[2]->{'type'} eq 'start') { @@ -317,31 +791,82 @@ sub parse_resource { } else { $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$/) || ($turi=~/\.page$/)) { $hash{'is_map_'.$rid}=1; - &loadmap($turi,$rid); + if ((!$hiddenurl{$rid}) || (&is_advanced($courseid))) { + &loadmap($turi,$rid,$courseid); + } } 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 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 { 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 $goesto=$lpc.'.'.$to; my $comesfrom=$lpc.'.'.$from; my $undercond=0; + + # If there is a condition, qualify it with the level counter. + if ($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{'comesfrom_'.$linkid}=$comesfrom; $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})) { $hash{'to_'.$comesfrom}.=','.$linkid; } else { @@ -355,6 +880,54 @@ sub make_link { } # ------------------------------------------------------------------- Condition +# +# Processes 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: +# +# +# +# +# +# +# +# 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 { my ($token,$lpc) = @_; my $rid=$lpc.'.'.$token->[2]->{'id'}; @@ -373,36 +946,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 of 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_)*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'}; } + + # 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; @@ -414,12 +1028,50 @@ sub parse_param { } } } - +# +# Parse mapalias parameters. +# these are tags of the form: +# +# 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 { my ($token,$lpc) = @_; + + # Fully qualify the to value and ignore the alias if there is no + # corresponding resource. + my $referid=$lpc.'.'.$token->[2]->{'to'}; 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.: + # + # + # + # 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$/) { &count_mapalias($token->[2]->{'value'},$referid); $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; @@ -428,6 +1080,10 @@ sub parse_mapalias_param { # --------------------------------------------------------- Simplify expression + +# +# Someone should really comment this to describe what it does to what and why. +# sub simplify { my $expression=shift; # (0&1) = 1 @@ -437,7 +1093,7 @@ sub simplify { # 8&8=8 $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; # (((5&3)|(4&6)))=((5&3)|(4&6)) @@ -451,9 +1107,38 @@ sub simplify { # -------------------------------------------------------- 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 { - my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; + my ($sofar,$rid,$beenhere,$encflag,$hdnflag,$cid)=@_; my $newsofar=$sofar=simplify($sofar); + unless ($beenhere=~/\&\Q$rid\E\&/) { $beenhere.=$rid.'&'; my ($mapid,$resid)=split(/\./,$rid); @@ -469,10 +1154,36 @@ sub traceroute { my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } + if (($retfrid eq '') && ($hash{'src_'.$rid}) && ($hash{'src_'.$rid}!~/\.sequence$/)) { $retfrid=$rid; } + + my (@deeplink,@recurseup); + if ($hash{'is_map_'.$rid}) { + my ($cdom,$cnum) = split(/_/,$cid); + my $mapsrc = $hash{'src_'.$rid}; + my $map_pc = $hash{'map_pc_'.$mapsrc}; + my @pcs = split(/,/,$hash{'map_hierarchy_'.$map_pc}); + shift(@pcs); + @recurseup = map { &Apache::lonnet::declutter($hash{'map_id_'.$_}) } reverse(@pcs); + my $mapname = &Apache::lonnet::declutter(&Apache::lonnet::deversion($mapsrc)); + my $deeplinkval = &get_mapparam($env{'user.name'},$env{'user.domain'},$cnum,$cdom, + $rid,$mapname,'0.deeplink',\@recurseup); + if ($deeplinkval ne '') { + @deeplink = ($deeplinkval,'map'); + } + } else { + my @pcs = split(/,/,$hash{'map_hierarchy_'.$mapid}); + shift(@pcs); + @recurseup = map { &Apache::lonnet::declutter($hash{'map_id_'.$_}) } reverse(@pcs); + @deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb,'','','','',$cid,\@recurseup); + } + unless (@deeplink < 2) { + $hash{'deeplinkonly_'.$rid}=join(':',map { &escape($_); } @deeplink); + } + if (defined($hash{'conditions_'.$rid})) { $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); @@ -482,8 +1193,11 @@ sub traceroute { # if the expression is just the 0th condition keep it # otherwise leave a pointer to this condition expression + $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid; + # Recurse if the resource is a map: + if (defined($hash{'is_map_'.$rid})) { if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { $sofar=$newsofar= @@ -491,22 +1205,35 @@ sub traceroute { $hash{'map_start_'.$hash{'src_'.$rid}}, $beenhere, $encflag || $encurl{$rid}, - $hdnflag || $hiddenurl{$rid}); + $hdnflag || $hiddenurl{$rid}, + $cid); } } + + # 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})) { foreach my $id (split(/\,/,$hash{'to_'.$rid})) { 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 (defined($hash{'condid_'.$hash{'undercond_'.$id}})) { $further=simplify('('.'_'.$rid.')&('. $hash{'condid_'.$hash{'undercond_'.$id}}.')'); } else { - $errtext.=&mt('
Undefined condition ID: [_1]',$hash{'undercond_'.$id}); + $errtext.= '
'. + &mt('Undefined condition ID: [_1]', + $hash{'undercond_'.$id}); } } + # Recurse to resoruces that have to's to us. $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, - $encflag,$hdnflag); + $encflag,$hdnflag,$cid); } } } @@ -515,16 +1242,33 @@ sub traceroute { # ------------------------------ Cascading conditions, quick access, parameters +# +# Seems a rather strangely named sub given what the comment above says it does. + + sub accinit { my ($uri,$short,$fn)=@_; my %acchash=(); my %captured=(); my $condcounter=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)) { + + # conditions: + if ($key=~/^conditions/) { my $expr=$hash{$key}; + # 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) { my $orig=$sub; @@ -538,11 +1282,16 @@ sub accinit { $expr=~s/\Q$orig\E/$sub/; } $hash{$key}=$expr; + + # If not yet seen, record in acchash and that we've seen it. + unless (defined($captured{$expr})) { $condcounter++; $captured{$expr}=$condcounter; $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; } + # Parameters: + } elsif ($key=~/^param_(\d+)\.(\d+)/) { my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2, $hash{'src_'.$1.'.'.$2}); @@ -556,6 +1305,8 @@ sub accinit { } } } + # This loop only processes id entries in the big hash. + foreach my $key (keys(%hash)) { if ($key=~/^ids/) { foreach my $resid (split(/\,/,$hash{$key})) { @@ -599,7 +1350,7 @@ sub accinit { sub hiddenurls { my $randomoutentry=''; - foreach my $rid (keys %randompick) { + foreach my $rid (keys(%randompick)) { my $rndpick=$randompick{$rid}; my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; # ------------------------------------------- put existing resources into array @@ -620,7 +1371,18 @@ sub hiddenurls { # -------------------------------- randomly eliminate the ones that should stay my (undef,$id)=split(/\./,$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 + if ($setcode) { + undef($env{'form.CODE'}); + undef($setcode); + } &Apache::lonnet::setup_random_from_rndseed($rndseed); my @whichids=&Math::Random::random_permuted_index($#currentrids+1); for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; } @@ -630,6 +1392,14 @@ sub hiddenurls { if ($currentrids[$k]) { $hash{'randomout_'.$currentrids[$k]}=1; my ($mapid,$resid)=split(/\./,$currentrids[$k]); + if ($rescount{$mapid}) { + $rescount{$mapid} --; + } + if ($hash{'is_map_'.$currentrids[$k]}) { + if ($mapcount{$mapid}) { + $mapcount{$mapid} --; + } + } $randomoutentry.='&'. &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, $resid, @@ -639,9 +1409,17 @@ sub hiddenurls { } } # ------------------------------ take care of explicitly hidden urls or folders - foreach my $rid (keys %hiddenurl) { + foreach my $rid (keys(%hiddenurl)) { $hash{'randomout_'.$rid}=1; my ($mapid,$resid)=split(/\./,$rid); + if ($rescount{$mapid}) { + $rescount{$mapid} --; + } + if ($hash{'is_map_'.$rid}) { + if ($mapcount{$mapid}) { + $mapcount{$mapid} --; + } + } $randomoutentry.='&'. &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid, $hash{'src_'.$rid}).'&'; @@ -652,12 +1430,59 @@ sub hiddenurls { } } +sub deeplinkouts { + my $deeplinkoutentry; + foreach my $rid (keys(%deeplinkout)) { + $hash{'deeplinkout_'.$rid}=1; + my ($mapid,$resid)=split(/\./,$rid); + $deeplinkoutentry.='&'. + &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid, + $hash{'src_'.$rid}).'&'; + } +# --------------------------------------- append deeplinkout entry to environment + if ($deeplinkoutentry) { + &Apache::lonnet::appenv({'acc.deeplinkout' => $deeplinkoutentry}); + } +} + +# -------------------------------------- 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 { + my ($cid) = @_; + foreach my $key (keys(%rescount)) { + if ($hash{'map_hierarchy_'.$key}) { + my $skipnext = 0; + foreach my $id (split(/,/,$hash{'map_hierarchy_'.$key}),$key) { + my $rid = $hash{'ids_'.$hash{'map_id_'.$id}}; + unless (($skipnext) || (!&is_advanced($cid) && $hash{'deeplinkout_'.$rid})) { + $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 sub readmap { - my $short=shift; + my ($short,$critmsg_check) = @_; $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; @@ -668,28 +1493,47 @@ sub readmap { } @cond=('true:normal'); - unless (open(LOCKFILE,">$fn.db.lock")) { - $errtext.='
'.&mt('Map not loaded - Lock file could not be opened when reading map:').' '.$fn.'.'; + unless (open(LOCKFILE,">","$fn.db.lock")) { + # + # Most likely a permissions problem on the lockfile or its directory. + # $retfurl = ''; - return ($retfurl,$errtext); + return ($retfurl,'
'.&mt('Map not loaded - Lock file could not be opened when reading map:').' '.$fn.'.'); } my $lock=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); } undef %randompick; + undef %randompickseed; + undef %randomorder; + undef %randomizationcode; undef %hiddenurl; undef %encurl; + undef %deeplinkout; + undef %rescount; + undef %mapcount; $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 (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); + $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.'.'); } @@ -705,7 +1549,10 @@ sub readmap { 'Could not untie coursemap hash '.$fn.' for '.$uri.'.'); } } - flock(LOCKFILE,LOCK_UN); + 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 @@ -713,6 +1560,13 @@ sub readmap { # 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); @@ -728,15 +1582,25 @@ sub readmap { 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)) { + + # 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; @@ -744,9 +1608,16 @@ sub readmap { $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}); + "request.course.uri" => $uri, + "request.course.tied" => time}); + $untiedhash = untie(%hash); $untiedparmhash = untie(%parmhash); $gotstate = 1; @@ -775,6 +1646,11 @@ 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) { $lock = 0; &Apache::lonnet::logthis('WARNING: '. @@ -784,13 +1660,23 @@ sub readmap { $lock=1; } undef %randompick; + undef %randompickseed; + undef %randomorder; + undef %randomizationcode; undef %hiddenurl; undef %encurl; + undef %deeplinkout; + undef %rescount; + undef %mapcount; + $errtext=''; $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); + $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.'.'); @@ -814,6 +1700,8 @@ sub readmap { 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.'.'); } @@ -821,45 +1709,84 @@ sub readmap { close(LOCKFILE); unless (($errtext eq '') || ($env{'request.course.uri'} =~ m{^/uploaded/})) { &Apache::lonmsg::author_res_msg($env{'request.course.uri'}, - $errtext); + $errtext); # TODO: User dependent? } # ------------------------------------------------- Check for critical messages - 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'; +# Depends on user must parameterize this as well..or separate as this is: +# more part of determining what someone sees on entering a course? +# When lonuserstate::readmap() is called from lonroles.pm, i.e., +# after selecting a role in a course, critical_redirect will be called, +# unless the course has a blocking event in effect, which suppresses +# critical message checking (users without evb priv). +# + + if ($critmsg_check) { + my ($redirect,$url) = &Apache::loncommon::critical_redirect(); + if ($redirect) { + $retfurl = $url; } } 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=(); + %hash=(); # empty the global course and parameter hashes. %parmhash=(); - $errtext=''; + $errtext=''; # No error messages yet. $pc=0; &clear_mapalias_count(); &processversionfile(%cenv); + + # URI Of the map file. + 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'); + + # 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})) { &Apache::lonnet::appenv({"request.course.id" => $short, "request.course.fn" => $fn, - "request.course.uri" => $uri}); + "request.course.uri" => $uri, + "request.course.tied" => time}); $env{'request.course.id'}=$short; - &traceroute('0',$hash{'map_start_'.$uri},'&'); + &traceroute('0',$hash{'map_start_'.$uri},'&','','',$short); &accinit($uri,$short,$fn); &hiddenurls(); } @@ -893,7 +1820,7 @@ sub build_tmp_hashes { # ---------------------------------------------------- Store away initial state { my $cfh; - if (open($cfh,">$fn.state")) { + if (open($cfh,">","$fn.state")) { print $cfh join("\n",@cond); $gotstate = 1; } else { @@ -901,12 +1828,100 @@ sub build_tmp_hashes { "Could not write statemap $fn for $uri."); } } + + # Was initial access via a deep-link? + my ($cdom,$cnum) = split(/_/,$short); + if (($cdom ne '') && ($env{'request.deeplink.login'} ne '')) { + my $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom); + if ($deeplink_symb) { + my ($loginrid,$deeplink_login_pc,$login_hierarchy); + my ($map,$resid,$url) = &Apache::lonnet::decode_symb($deeplink_symb); + $loginrid = $hash{'map_pc_'.&Apache::lonnet::clutter($map)}.'.'.$resid; + if ($deeplink_symb =~ /\.(page|sequence)$/) { + $deeplink_login_pc = $hash{'map_pc_'.&Apache::lonnet::clutter($url)}; + } else { + $deeplink_login_pc = $hash{'map_pc_'.&Apache::lonnet::clutter($map)}; + } + my $deeplink; + if ($hash{'deeplinkonly_'.$loginrid} ne '') { + my @deeplinkinfo = map { &unescape($_); } split(/:/,$hash{'deeplinkonly_'.$loginrid}); + unless (@deeplinkinfo < 2) { + $deeplink = $deeplinkinfo[0]; + } + } + if ($deeplink) { + my $disallow; + my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink); + if (($protect ne 'none') && ($protect ne '')) { + my ($acctype,$item) = split(/:/,$protect); + if ($acctype =~ /lti(c|d)$/) { + unless ($env{'request.linkprot'} eq $item.$1.':'.$env{'request.deeplink.login'}) { + $disallow = 1; + } + } elsif ($acctype eq 'key') { + unless ($env{'request.linkkey'} eq $item) { + $disallow = 1; + } + } + } + if ($disallow) { + &Apache::lonnet::delenv('request.deeplink.login'); + if ($env{'request.deeplink.target'} ne '') { + &Apache::lonnet::delenv('request.deeplink.target'); + } + } else { + if ($others eq 'hide') { + my @recfolders; + if ($scope eq 'rec') { + foreach my $key (keys(%hash)) { + if ($key=~/^map_hierarchy_(\d+)$/) { + my $mpc = $1; + my @ids = split(/,/,$hash{$key}); + if (grep(/^$deeplink_login_pc$/,@ids)) { + my $idx; + foreach my $mapid (@ids) { + if ($idx) { + push(@recfolders,$mapid); + } elsif ($mapid == $deeplink_login_pc) { + push(@recfolders,$mapid); + $idx = $mapid; + } + } + push(@recfolders,$mpc); + } + } + } + } + foreach my $key (keys(%hash)) { + if ($key=~/^src_(.+)$/) { + my $rid = $1; + next if ($rid eq '0.0'); + next if ($rid eq $loginrid); + if ($scope ne 'res') { + my $mapid = (split(/\./,$rid))[0]; + next if ($mapid eq $deeplink_login_pc); + if ($scope eq 'rec') { + next if (grep(/^$mapid$/,@recfolders)); + } + } + $deeplinkout{$rid} = 1; + } + } + } + } + &deeplinkouts(); + } + } + } + &mapcrumbs(); return $gotstate; } sub unlink_tmpfiles { 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); foreach my $file (@files) { if (-e $fn.$file) { @@ -928,7 +1943,7 @@ sub evalstate { if (-e $fn) { my @conditions=(); { - open(my $fh,"<$fn"); + open(my $fh,"<",$fn); @conditions=<$fh>; close($fh); } @@ -960,6 +1975,184 @@ sub evalstate { return $state; } +sub get_mapparam { + my ($uname,$udom,$cnum,$cdom,$rid,$mapname,$what,$recurseupref) = @_; + unless ($mapname) { return; } + +# ------------------------------------------------- Get coursedata (if present) + my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom); + if (!ref($courseopt)) { + undef($courseopt); + } + +# --------------------------------------------------- Get userdata (if present) + my $useropt=&Apache::lonnet::get_userresdata($uname,$udom); + if (!ref($useropt)) { + undef($useropt); + } + + my @recurseup; + if (ref($recurseupref) eq 'ARRAY') { + @recurseup = @{$recurseupref}; + } + + # Get the section if there is one. + + my $cid = $cdom.'_'.$cnum; + my $csec=$env{'request.course.sec'}; + my $cgroup=''; + my @cgrps=split(/:/,$env{'request.course.groups'}); + if (@cgrps > 0) { + @cgrps = sort(@cgrps); + $cgroup = $cgrps[0]; + } + + my $rwhat=$what; + $what=~s/^parameter\_//; + $what=~s/\_/\./; + + # Build the hash keys for the lookup: + + my $mapparm=$mapname.'___(all).'.$what; + my $recurseparm=$mapname.'___(rec).'.$what; + my $usercourseprefix=$cid; + + my $grplevelm = "$usercourseprefix.[$cgroup].$mapparm"; + my $seclevelm = "$usercourseprefix.[$csec].$mapparm"; + my $courselevelm = "$usercourseprefix.$mapparm"; + + my $grpleveli = "$usercourseprefix.[$cgroup].$recurseparm"; + my $secleveli = "$usercourseprefix.[$csec].$recurseparm"; + my $courseleveli = "$usercourseprefix.$recurseparm"; + + # Check per user + + if ($uname and defined($useropt)) { + if (defined($$useropt{$courselevelm})) { + return $$useropt{$courselevelm}; + } + if (defined($$useropt{$courseleveli})) { + return $$useropt{$courseleveli}; + } + foreach my $item (@recurseup) { + my $norecursechk=$usercourseprefix.'.'.$item.'___(all).'.$what; + if (defined($$useropt{$norecursechk})) { + if ($what =~ /\.(encrypturl|hiddenresource)$/) { + return $$useropt{$norecursechk}; + } else { + last; + } + } + my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what; + if (defined($$useropt{$recursechk})) { + return $$useropt{$recursechk}; + } + } + } + + # Check course -- group + + if ($cgroup ne '' and defined ($courseopt)) { + if (defined($$courseopt{$grplevelm})) { + return $$courseopt{$grplevelm}; + } + if (defined($$courseopt{$grpleveli})) { + return $$courseopt{$grpleveli}; + } + foreach my $item (@recurseup) { + my $norecursechk=$usercourseprefix.'.['.$cgroup.'].'.$item.'___(all).'.$what; + if (defined($$courseopt{$norecursechk})) { + if ($what =~ /\.(encrypturl|hiddenresource)$/) { + return $$courseopt{$norecursechk}; + } else { + last; + } + } + my $recursechk=$usercourseprefix.'.['.$cgroup.'].'.$item.'___(rec).'.$what; + if (defined($$courseopt{$recursechk})) { + return $$courseopt{$recursechk}; + } + } + } + + # Check course -- section + + if ($csec ne '' and defined($courseopt)) { + if (defined($$courseopt{$seclevelm})) { + return $$courseopt{$seclevelm}; + } + if (defined($$courseopt{$secleveli})) { + return $$courseopt{$secleveli}; + } + foreach my $item (@recurseup) { + my $norecursechk=$usercourseprefix.'.['.$csec.'].'.$item.'___(all).'.$what; + if (defined($$courseopt{$norecursechk})) { + if ($what =~ /\.(encrypturl|hiddenresource)$/) { + return $$courseopt{$norecursechk}; + } else { + last; + } + } + my $recursechk=$usercourseprefix.'.['.$csec.'].'.$item.'___(rec).'.$what; + if (defined($$courseopt{$recursechk})) { + return $$courseopt{$recursechk}; + } + } + } + + # Check the map parameters themselves: + + if ($hash{'param_'.$rid}) { + my @items = split(/\&/,$hash{'param_'.$rid}); + my $thisparm; + foreach my $item (@items) { + my ($esctype,$escname,$escvalue) = ($item =~ /^([^:]+):([^=]+)=(.*)$/); + my $name = &unescape($escname); + my $value = &unescape($escvalue); + if ($name eq $what) { + $thisparm = $value; + last; + } + } + if (defined($thisparm)) { + return $thisparm; + } + } + + # Additional course parameters: + + if (defined($courseopt)) { + if (defined($$courseopt{$courselevelm})) { + return $$courseopt{$courselevelm}; + } + + if (defined($$courseopt{$courseleveli})) { + return $$courseopt{$courseleveli}; + } + + if (@recurseup) { + foreach my $item (@recurseup) { + my $norecursechk=$usercourseprefix.'.'.$item.'___(all).'.$what; + if (defined($$courseopt{$norecursechk})) { + if ($what =~ /\.(encrypturl|hiddenresource)$/) { + return $$courseopt{$norecursechk}; + } else { + last; + } + } + my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what; + if (defined($$courseopt{$recursechk})) { + return $$courseopt{$recursechk}; + } + } + } + } + return undef; +} + +# This block seems to have code to manage/detect doubly defined +# aliases in maps. + { my %mapalias_cache; sub count_mapalias { @@ -980,8 +2173,8 @@ sub evalstate { $count++; } my ($mapid) = split(/\./,$id); - &mt('Resource "[_1]"
in Map "[_2]"', - $hash{'title_'.$id}, + &mt('Resource [_1][_2]in Map [_3]', + $hash{'title_'.$id},'
', $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); } (@{ $mapalias_cache{$mapalias} })); next if ($count < 2);