--- rat/lonuserstate.pm 2011/08/04 10:57:26 1.139
+++ rat/lonuserstate.pm 2022/10/05 22:54:00 1.149.2.5.2.3
@@ -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.149.2.5.2.3 2022/10/05 22:54:00 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
@@ -131,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?
@@ -172,7 +187,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 +196,13 @@ 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");
+ $hash{'map_type_'.$lpc}='none';
+ if (&is_advanced($courseid)) {
+ $errtext .= &error_detail($parent_rid,$courseid,$ispage,$uri);
+ }
return;
}
@@ -225,15 +246,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 +292,17 @@ 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;
- # 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 +321,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 +369,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');
@@ -321,6 +380,232 @@ 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);
+ $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 ($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');
+ }
+ my $fileurl = $uri;
+ $fileurl =~s{^/res/}{/priv/};
+ 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 {
+ &js_escape(\$fileurl);
+ $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');
+ }
+ my $mapurl = $hash{'map_id_'.$parent_pc};
+ $mapurl =~s{^/res/}{/priv/};
+ if ($switchserver) {
+ $errinfo .= '.
'.
+ &mt('You will need to [_1]switch server[_2].',
+ '','');
+ } else {
+ &js_escape(\$mapurl);
+ $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
#
@@ -337,6 +622,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 +643,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).
@@ -406,7 +692,11 @@ sub parse_resource {
# is not a page. If the resource is a page then it must be
# assembled (at fetch time?).
- unless ($ispage) {
+ 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
@@ -421,6 +711,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 +788,9 @@ sub parse_resource {
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'};
}
@@ -652,7 +946,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 +1015,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 +1067,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 +1080,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 +1094,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);
@@ -776,10 +1141,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.')');
@@ -789,8 +1180,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=
@@ -798,22 +1192,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);
}
}
}
@@ -822,16 +1229,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 +1269,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 +1292,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 +1337,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 +1358,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 +1379,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 +1396,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,10 +1417,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:
@@ -979,13 +1480,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.='
'.&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;
@@ -998,9 +1498,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.
@@ -1095,7 +1602,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;
@@ -1138,8 +1647,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.
@@ -1186,14 +1702,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);
}
@@ -1226,6 +1746,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,13 +1757,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();
}
@@ -1274,7 +1807,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 {
@@ -1282,6 +1815,92 @@ 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;
}
@@ -1289,7 +1908,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) {
@@ -1311,7 +1930,7 @@ sub evalstate {
if (-e $fn) {
my @conditions=();
{
- open(my $fh,"<$fn");
+ open(my $fh,"<",$fn);
@conditions=<$fh>;
close($fh);
}
@@ -1343,6 +1962,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.
@@ -1366,8 +2144,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);