--- rat/lonuserstate.pm 2012/11/11 22:26:49 1.144 +++ rat/lonuserstate.pm 2024/07/03 02:16:44 1.149.2.6 @@ -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.144 2012/11/11 22:26:49 raeburn Exp $ +# $Id: lonuserstate.pm,v 1.149.2.6 2024/07/03 02:16:44 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 @@ -140,10 +143,10 @@ sub processversionfile { # 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? @@ -183,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; } @@ -192,7 +195,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; } @@ -236,15 +245,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 @@ -260,17 +291,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}; @@ -289,18 +320,30 @@ 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); + if ($setcode) { + undef($env{'form.CODE'}); + undef($setcode); + } + # Take the set of map ids we have decoded and permute them to a # random order based on the seed set above. All of this is # processing the randomorder parameter if it is set, not # randompick. - @map_ids=&Math::Random::random_permutation(@map_ids); + @map_ids=&Math::Random::random_permutation(@map_ids); } - my $from = shift(@map_ids); my $from_rid = $lpc.'.'.$from; $hash{'map_start_'.$uri} = $from_rid; @@ -325,7 +368,7 @@ sub loadmap { $parser = HTML::TokeParser->new(\$instr); $parser->attr_encoded(1); - # last parse out the mapalias params. Thes provide mnemonic + # last parse out the mapalias params. These provide mnemonic # tags to resources that can be used in conditions while (my $token = $parser->get_token) { @@ -336,6 +379,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 # @@ -352,6 +621,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. # @@ -372,7 +642,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,7 +691,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 @@ -511,7 +785,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'}; } @@ -667,7 +943,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 { @@ -909,7 +1185,9 @@ sub traceroute { $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. @@ -1031,7 +1309,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 @@ -1052,7 +1330,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]]=''; } @@ -1062,6 +1351,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, @@ -1071,9 +1368,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}).'&'; @@ -1084,10 +1389,36 @@ 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 { - my $short=shift; + my ($short,$critmsg_check) = @_; $short=~s/^\///; # TODO: Hidden dependency on current user: @@ -1104,7 +1435,7 @@ 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. # @@ -1122,8 +1453,13 @@ sub readmap { &unlink_tmpfiles($fn); } undef %randompick; + undef %randompickseed; + undef %randomorder; + undef %randomizationcode; undef %hiddenurl; undef %encurl; + undef %rescount; + undef %mapcount; $retfrid=''; $errtext=''; my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags. @@ -1265,8 +1601,13 @@ sub readmap { $lock=1; } undef %randompick; + undef %randompickseed; + undef %randomorder; + undef %randomizationcode; undef %hiddenurl; undef %encurl; + undef %rescount; + undef %mapcount; $errtext=''; $retfrid=''; # @@ -1314,14 +1655,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); } @@ -1370,7 +1715,7 @@ sub build_tmp_hashes { # sub-maps. - &loadmap($uri,'0.0'); + &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? @@ -1385,6 +1730,7 @@ sub build_tmp_hashes { &traceroute('0',$hash{'map_start_'.$uri},'&'); &accinit($uri,$short,$fn); &hiddenurls(); + &mapcrumbs(); } $errtext .= &get_mapalias_errors(); # ------------------------------------------------------- Put versions into src @@ -1416,7 +1762,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 { @@ -1431,7 +1777,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) { @@ -1453,7 +1799,7 @@ sub evalstate { if (-e $fn) { my @conditions=(); { - open(my $fh,"<$fn"); + open(my $fh,"<",$fn); @conditions=<$fh>; close($fh); } @@ -1508,8 +1854,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);