--- rat/lonuserstate.pm 2011/07/26 10:40:23 1.138 +++ rat/lonuserstate.pm 2022/01/02 16:30:29 1.149.2.5.2.1 @@ -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.138 2011/07/26 10:40:23 foxr Exp $ +# $Id: lonuserstate.pm,v 1.149.2.5.2.1 2022/01/02 16:30:29 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,7 +42,7 @@ use Safe::Hole; use Opcode; use Apache::lonenc; use Fcntl qw(:flock); -use LONCAPA; +use LONCAPA qw(:DEFAULT :match); use File::Basename; @@ -59,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 @@ -70,6 +74,21 @@ sub versionerror { $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 { my $uri=shift; if ($uri=~/\.(\d+)\.\w+$/) { @@ -116,8 +135,19 @@ sub processversionfile { # --------------------------------------------------------- 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? @@ -157,7 +187,7 @@ sub loadmap { # We can only nest sequences or pages. Anything else is an illegal nest. unless (($fn=~/\.sequence$/) || $ispage) { - $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn); + $errtext.='<br />'.&mt('Invalid map: [_1]',"<tt>$fn</tt>"); return; } @@ -166,7 +196,9 @@ sub loadmap { my $instr=&Apache::lonnet::getfile($fn); 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; } @@ -210,15 +242,37 @@ sub loadmap { # 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') { - my $resource_id = &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 @@ -226,7 +280,7 @@ sub loadmap { } elsif ($token->[1] eq 'link' && !$randomize) { &make_link(++$linkpc,$lpc,$token->[2]->{'to'}, $token->[2]->{'from'}, - $token->[2]->{'condition'}); + $token->[2]->{'condition'}); # note ..condition may be undefined. # condition @@ -234,16 +288,24 @@ sub loadmap { &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}, @@ -252,18 +314,42 @@ sub loadmap { $seed = $symb; } - # Here for sure we need to pass along the username/domain + # 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; @@ -278,8 +364,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') { @@ -288,6 +376,18 @@ 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; +} # -------------------------------------------------------------------- Resource # @@ -304,7 +404,9 @@ sub loadmap { # $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: @@ -323,12 +425,16 @@ sub loadmap { sub parse_resource { - my ($token,$lpc,$ispage,$uri) = @_; + my ($token,$lpc,$ispage,$uri,$courseid) = @_; - # I refuse to coutenance code like this that has + # 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. @@ -336,23 +442,43 @@ sub parse_resource { return undef; } - my $rid=$lpc.'.'.$token->[2]->{'id'}; + 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 @@ -367,6 +493,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/[^\/]+$//; @@ -378,7 +506,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})) { @@ -387,17 +518,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') { @@ -409,31 +560,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 <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 { 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 { @@ -447,6 +649,54 @@ sub make_link { } # ------------------------------------------------------------------- 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 { my ($token,$lpc) = @_; my $rid=$lpc.'.'.$token->[2]->{'id'}; @@ -478,7 +728,7 @@ sub parse_condition { # Typical attributes: # to=n - Number of the resource the parameter applies to. # type=xx - Type of parameter value (e.g. string_yesno or int_pos). -# name=xxx - Name ofr parameter (e.g. parameter_randompick or parameter_randomorder). +# name=xxx - Name of parameter (e.g. parameter_randompick or parameter_randomorder). # value=xxx - value of the parameter. sub parse_param { @@ -547,12 +797,50 @@ 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 { 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.: + # <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$/) { &count_mapalias($token->[2]->{'value'},$referid); $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; @@ -561,6 +849,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 @@ -570,7 +862,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)) @@ -584,9 +876,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); @@ -602,10 +923,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.')'); @@ -615,8 +962,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= @@ -624,22 +974,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('<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, - $encflag,$hdnflag); + $encflag,$hdnflag,$cid); } } } @@ -648,16 +1011,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; @@ -671,11 +1051,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}); @@ -689,6 +1074,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})) { @@ -732,7 +1119,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 @@ -753,7 +1140,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]]=''; } @@ -763,6 +1161,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, @@ -772,9 +1178,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}).'&'; @@ -785,10 +1199,53 @@ 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/^\///; # TODO: Hidden dependency on current user: @@ -805,13 +1262,12 @@ sub readmap { } @cond=('true:normal'); - unless (open(LOCKFILE,">$fn.db.lock")) { + unless (open(LOCKFILE,">","$fn.db.lock")) { # # Most likely a permissions problem on the lockfile or its directory. # - $errtext.='<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.'; $retfurl = ''; - return ($retfurl,$errtext); + return ($retfurl,'<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.'); } my $lock=0; my $gotstate=0; @@ -824,9 +1280,16 @@ sub readmap { &unlink_tmpfiles($fn); } undef %randompick; + undef %randompickseed; + undef %randomorder; + undef %randomizationcode; undef %hiddenurl; undef %encurl; + undef %deeplinkout; + undef %rescount; + undef %mapcount; $retfrid=''; + $errtext=''; my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags. # if we got the lock, regenerate course regnerate empty files and tie them. @@ -921,7 +1384,9 @@ sub readmap { # &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; @@ -964,8 +1429,15 @@ 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. @@ -1012,14 +1484,18 @@ sub readmap { # 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). +# - 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'; + if ($critmsg_check) { + my ($redirect,$url) = &Apache::loncommon::critical_redirect(); + if ($redirect) { + $retfurl = $url; } - } + } return ($retfurl,$errtext); } @@ -1052,6 +1528,9 @@ sub build_tmp_hashes { $pc=0; &clear_mapalias_count(); &processversionfile(%cenv); + + # URI Of the map file. + my $furi=&Apache::lonnet::clutter($uri); # # the map staring points. @@ -1060,13 +1539,23 @@ sub build_tmp_hashes { $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(); } @@ -1100,7 +1589,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 { @@ -1108,6 +1597,89 @@ sub build_tmp_hashes { "Could not write statemap $fn for $uri.</font>"); } } + + # 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'); + } 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; } @@ -1115,7 +1687,7 @@ sub unlink_tmpfiles { my ($fn) = @_; my $file_dir = dirname($fn); - if ($fn eq LONCAPA::tempdir()) { + if ("$file_dir/" eq LONCAPA::tempdir()) { my @files = qw (.db _symb.db .state _parms.db); foreach my $file (@files) { if (-e $fn.$file) { @@ -1137,7 +1709,7 @@ sub evalstate { if (-e $fn) { my @conditions=(); { - open(my $fh,"<$fn"); + open(my $fh,"<",$fn); @conditions=<$fh>; close($fh); } @@ -1169,6 +1741,165 @@ 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; + } + } + } + } + + # 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; + } + } + } + } + + # 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; + } + } + } + } + + # 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; + } + } + } + } + } + return undef; +} + # This block seems to have code to manage/detect doubly defined # aliases in maps. @@ -1192,8 +1923,8 @@ sub evalstate { $count++; } my ($mapid) = split(/\./,$id); - &mt('Resource "[_1]" <br /> in Map "[_2]"', - $hash{'title_'.$id}, + &mt('Resource [_1][_2]in Map [_3]', + $hash{'title_'.$id},'<br />', $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); } (@{ $mapalias_cache{$mapalias} })); next if ($count < 2);