--- rat/lonuserstate.pm 2011/08/04 10:57:26 1.139 +++ rat/lonuserstate.pm 2017/09/03 18:52:23 1.153 @@ -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.139 2011/08/04 10:57:26 foxr Exp $ +# $Id: lonuserstate.pm,v 1.153 2017/09/03 18:52:23 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,11 @@ 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 %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 @@ -131,8 +134,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? @@ -172,7 +186,7 @@ sub loadmap { # We can only nest sequences or pages. Anything else is an illegal nest. unless (($fn=~/\.sequence$/) || $ispage) { - $errtext.=&mt("
Invalid map: [_1]",$fn); + $errtext.='
'.&mt('Invalid map: [_1]',"$fn"); return; } @@ -181,7 +195,9 @@ sub loadmap { 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"); return; } @@ -225,15 +241,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); + 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 @@ -249,17 +287,25 @@ sub loadmap { &parse_condition($token,$lpc); } } - + undef($codechecked); # Handle randomization and random selection if ($randomize) { - if (!$env{'request.role.adv'}) { + my $advanced; + if ($env{'request.course.id'}) { + $advanced = (&Apache::lonnet::allowed('adv') eq 'F'); + } else { + $env{'request.course.id'} = $courseid; + $advanced = (&Apache::lonnet::allowed('adv') eq 'F'); + $env{'request.course.id'} = ''; + } + unless ($advanced) { + # Order of resources is not randomized if user has and advanced role in the course. my $seed; - # In the advanced role, the map's random seed - # parameter is used as the basis for computing the - # seed ... if it has been specified: + # 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}; @@ -278,22 +324,38 @@ sub loadmap { # 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); - @map_ids=&math::Random::random_permutation(@map_ids); # randomorder. - } + 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 this random ordering. - # BUG? If there are conditions, this invalidates them? Then again - # with randompick there's no gaurentee the resources required for the - # conditinos to work will be selected into the map. - # so randompick is inconsistent with a map that has conditions? + # 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); @@ -310,8 +372,8 @@ 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'); @@ -337,6 +399,7 @@ 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. # @@ -357,7 +420,7 @@ sub loadmap { sub parse_resource { - my ($token,$lpc,$ispage,$uri) = @_; + 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). @@ -421,6 +484,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/[^\/]+$//; @@ -496,7 +561,7 @@ sub parse_resource { if (($turi=~/\.sequence$/) || ($turi=~/\.page$/)) { $hash{'is_map_'.$rid}=1; - &loadmap($turi,$rid); + &loadmap($turi,$rid,$courseid); } return $token->[2]->{'id'}; } @@ -652,7 +717,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 { @@ -721,12 +786,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; @@ -735,6 +838,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 @@ -744,7 +851,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)) @@ -758,9 +865,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 $newsofar=$sofar=simplify($sofar); + unless ($beenhere=~/\&\Q$rid\E\&/) { $beenhere.=$rid.'&'; my ($mapid,$resid)=split(/\./,$rid); @@ -776,10 +912,12 @@ 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; } + if (defined($hash{'conditions_'.$rid})) { $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); @@ -789,8 +927,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= @@ -801,17 +942,29 @@ sub traceroute { $hdnflag || $hiddenurl{$rid}); } } + + # Processes links to this resource: + # - verify the existence of any conditionals on the link to here. + # - Recurse to any resources linked to us. + # if (defined($hash{'to_'.$rid})) { 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); } @@ -822,16 +975,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; @@ -845,11 +1015,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}); @@ -863,6 +1038,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})) { @@ -906,7 +1083,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 @@ -927,7 +1104,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]]=''; } @@ -937,6 +1125,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, @@ -946,9 +1142,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}).'&'; @@ -959,6 +1163,32 @@ sub hiddenurls { } } +# -------------------------------------- populate big hash with map breadcrumbs + +# Create map_breadcrumbs_$pc from map_hierarchy_$pc by omitting intermediate +# maps not shown in Course Contents table. + +sub mapcrumbs { + foreach my $key (keys(%rescount)) { + if ($hash{'map_hierarchy_'.$key}) { + my $skipnext = 0; + foreach my $id (split(/,/,$hash{'map_hierarchy_'.$key}),$key) { + unless ($skipnext) { + $hash{'map_breadcrumbs_'.$key} .= "$id,"; + } + unless (($id == 0) || ($id == 1)) { + if ((!$rescount{$id}) || ($rescount{$id} == 1 && $mapcount{$id} == 1)) { + $skipnext = 1; + } else { + $skipnext = 0; + } + } + } + $hash{'map_breadcrumbs_'.$key} =~ s/,$//; + } + } +} + # ---------------------------------------------------- Read map and all submaps sub readmap { @@ -983,9 +1213,8 @@ sub readmap { # # Most likely a permissions problem on the lockfile or its directory. # - $errtext.='
'.&mt('Map not loaded - Lock file could not be opened when reading map:').' '.$fn.'.'; $retfurl = ''; - return ($retfurl,$errtext); + return ($retfurl,'
'.&mt('Map not loaded - Lock file could not be opened when reading map:').' '.$fn.'.'); } my $lock=0; my $gotstate=0; @@ -1001,6 +1230,7 @@ sub readmap { undef %hiddenurl; undef %encurl; $retfrid=''; + $errtext=''; my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags. # if we got the lock, regenerate course regnerate empty files and tie them. @@ -1095,7 +1325,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; @@ -1140,6 +1372,7 @@ sub readmap { undef %randompick; undef %hiddenurl; undef %encurl; + $errtext=''; $retfrid=''; # # Once more through the routine of tying and loading and so on. @@ -1226,6 +1459,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. @@ -1234,15 +1470,27 @@ 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},'&'); &accinit($uri,$short,$fn); &hiddenurls(); + &mapcrumbs(); } $errtext .= &get_mapalias_errors(); # ------------------------------------------------------- Put versions into src @@ -1289,7 +1537,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) { @@ -1366,8 +1614,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);