--- loncom/lonmap.pm 2011/09/07 10:58:36 1.1 +++ loncom/lonmap.pm 2013/01/03 20:32:40 1.9 @@ -2,7 +2,7 @@ # # Read maps into a 'big hash'. # -# $Id: lonmap.pm,v 1.1 2011/09/07 10:58:36 foxr Exp $ +# $Id: lonmap.pm,v 1.9 2013/01/03 20:32:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,7 +28,7 @@ # ### -package lonmap; +package Apache::lonmap; use strict; #------------- Required external modules. @@ -38,12 +38,16 @@ use Error qw(:try); use HTML::TokeParser; -use Apache::LONCAPA; +use LONCAPA; use Apache::lonnet; +use Apache::lonlocal; + +use Data::Dumper; + #------------- File scoped variables: -my $map_number = 1; # keep track of maps within the course. +my $map_number = 0; # keep track of maps within the course. my $course_id; # Will be the id of the course being read in. # @@ -56,8 +60,9 @@ my %randompickseed; my %randomorder; my %encurl; my %hiddenurl; +my %parmhash; my @cond; # Array of conditions. - +my $retfrid; # # Other stuff we make global (sigh) so that it does not need # to be passed around all the time: @@ -65,7 +70,9 @@ my @cond; # Array of conditions. my $username; # User for whom the map is being read. my $userdomain; # Domain the user lives in. +my $short_name; # Course shortname. my %mapalias_cache; # Keeps track of map aliases -> resources detects duplicates. +my %cenv; # Course environment. #------------- Executable code: @@ -91,10 +98,7 @@ my %mapalias_cache; # Keeps track of ma sub simplify { my $expression=shift; - my $prior = ''; # This is safe as a null expression is pretty optimal. - - while ($prior ne $expression) { - $prior = $expression; # Stop when the substitutions below do nothing. + # (0&1) = 1 $expression=~s/\(0\&([_\.\d]+)\)/$1/g; # (8)=8 @@ -111,7 +115,8 @@ sub simplify { # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) $expression=~ s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g; - } + + return $expression; } @@ -128,7 +133,7 @@ sub simplify { sub merge_conditions { my $hash = shift; - for (my $i = 0; i < scalar(@cond); i++) { + for (my $i = 0; $i < scalar(@cond); $i++) { $hash->{'condition' . '.' . $i} = $cond[$i]; } } @@ -148,8 +153,12 @@ sub merge_conditions { sub merge_hash { my ($parent, $key, $child) = @_; + if ($key ne '') { + $key .= '.'; # If we are prefixing, prefix then . + } + foreach my $childkey (keys (%$child)) { - $parent->{$key . '.' . $childkey} = $child->{$childkey}; + $parent->{$key . $childkey} = $child->{$childkey}; } } @@ -181,7 +190,7 @@ sub count_mapalias { # result string.' # # Parameters: -# none +# hash - Reference to the hash we are trying t build up. # Implicit inputs # %mapalias - a hash that is indexed by map aliases and contains for each key # an array of the resource id's the alias 'points to'. @@ -191,6 +200,7 @@ sub count_mapalias { # # sub get_mapalias_errors { + my $hash = shift; my $error_text; foreach my $mapalias (sort(keys(%mapalias_cache))) { next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); @@ -199,13 +209,13 @@ sub get_mapalias_errors { join('
  • ', map { my $id = $_; - if (exists($hash{'src_'.$id})) { + if (exists($hash->{'src_'.$id})) { $count++; } my ($mapid) = split(/\./,$id); &mt('Resource "[_1]"
    in Map "[_2]"', - $hash{'title_'.$id}, - $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); + $hash->{'title_'.$id}, + $hash->{'title_'.$hash->{'ids_'.$hash->{'map_id_'.$mapid}}}); } (@{ $mapalias_cache{$mapalias} })); next if ($count < 2); $error_text .= '
    '. @@ -229,6 +239,31 @@ sub clear_mapalias_count { # # +# Put a version into a src element of a hash or url: +# +# Parameters: +# uri - URI into which the version must be added. +# hash - Reference to the hash being built up. +# short- Short coursename. +# + +sub putinversion { + my ($uri, $hash, $short) = @_; + my $key=$short.'_'.&Apache::lonnet::clutter($uri); + if ($hash->{'version_'.$uri}) { + my $version=$hash->{'version_'.$uri}; + if ($version eq 'mostrecent') { return $uri; } + if ($version eq &Apache::lonnet::getversion( + &Apache::lonnet::filelocation('',$uri))) + { return $uri; } + $uri=~s/\.(\w+)$/\.$version\.$1/; + } + &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); + return $uri; +} + + +# # Create hash entries for each version of the course. # Parameters: # $cenv - Reference to a course environment from lonnet::coursedescription. @@ -260,7 +295,6 @@ sub process_versions { # sub versionerror { my ($uri, $used, $unused) = @_; - my ($uri,$usedversion,$unusedversion)=@_; return '
    '. &mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].', $uri,$used,$unused).'
    '; @@ -281,7 +315,7 @@ sub versionerror { # Returns: # URI with the version cut out. # -sub vesiontrack { +sub versiontrack { my ($uri, $hash) = @_; @@ -291,7 +325,7 @@ sub vesiontrack { unless ($hash->{'version_'.$uri}) { $hash->{'version_'.$uri}=$version; } elsif ($version!=$hash->{'version_'.$uri}) { - throw Error::Simple(&versionerror($uri,$hash{'version_'.$uri},$version)); + throw Error::Simple(&versionerror($uri, $hash->{'version_'.$uri}, $version)); } } return $uri; @@ -339,11 +373,41 @@ sub append_version { return $uri; } +#------------------------------------------------------------------------------ +# +# Misc. utilities that don't fit into the other classifications. + +# Determine if the specified user has an 'advanced' role in a course. +# Parameters: +# cenv - reference to a course environment. +# username - Name of the user we care about. +# domain - Domain in which the user is defined. +# Returns: +# 0 - User does not have an advanced role in the course. +# 1 - User does have an advanced role in the course. +# +sub has_advanced_role { + my ($username, $domain) = @_; + + my %adv_roles = &Apache::lonnet::get_course_adv_roles($short_name); + my $merged_username = $username . ':' . $domain; + foreach my $user (values %adv_roles) { + if ($merged_username eq $user) { + return 1; + } + } + return 0; +} + #-------------------------------------------------------------------------------- # Post processing subs: sub hiddenurls { my $hash = shift; + my $uname = $hash->{'context.username'}; + my $udom = $hash->{'context.userdom'}; + my $courseid = $hash->{'context.courseid'}; + my $randomoutentry=''; foreach my $rid (keys %randompick) { my $rndpick=$randompick{$rid}; @@ -366,15 +430,15 @@ sub hiddenurls { # -------------------------------- randomly eliminate the ones that should stay my (undef,$id)=split(/\./,$rid); if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; } - my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb + my $rndseed=&Apache::lonnet::rndseed($id, $courseid, $udom, $uname, \%cenv); # use id instead of symb &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]]=''; } - #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids)); + # -------------------------------------------------------- delete the leftovers for (my $k=0; $k<=$#currentrids; $k++) { if ($currentrids[$k]) { - $hash->{'randomout_'.$currentrids[$k]}=1; + $hash->{'randomout_'.$currentrids[$k]}='1'; my ($mapid,$resid)=split(/\./,$currentrids[$k]); $randomoutentry.='&'. &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid}, @@ -386,7 +450,7 @@ sub hiddenurls { } # ------------------------------ take care of explicitly hidden urls or folders foreach my $rid (keys %hiddenurl) { - $hash->{'randomout_'.$rid}=1; + $hash->{'randomout_'.$rid}='1'; my ($mapid,$resid)=split(/\./,$rid); $randomoutentry.='&'. &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid, @@ -410,7 +474,7 @@ sub hiddenurls { # sub accinit { - my ($uri,$short,$fn)=@_; + my ($uri, $short, $hash)=@_; my %acchash=(); my %captured=(); my $condcounter=0; @@ -542,7 +606,7 @@ sub accinit { # 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, $hash)=@_; my $newsofar=$sofar=simplify($sofar); unless ($beenhere=~/\&\Q$rid\E\&/) { @@ -588,7 +652,7 @@ sub traceroute { $hash->{'map_start_'.$hash->{'src_'.$rid}}, $beenhere, $encflag || $encurl{$rid}, - $hdnflag || $hiddenurl{$rid}); + $hdnflag || $hiddenurl{$rid}, $hash); } } @@ -608,13 +672,13 @@ sub traceroute { $further=simplify('('.'_'.$rid.')&('. $hash->{'condid_'.$hash->{'undercond_'.$id}}.')'); } else { - $errtext.=&mt('
    Undefined condition ID: [_1]',$hash->{'undercond_'.$id}); + my $errtext.=&mt('
    Undefined condition ID: [_1]',$hash->{'undercond_'.$id}); throw Error::Simple($errtext); } } # Recurse to resoruces that have to's to us. $newsofar=&traceroute($further,$hash->{'goesto_'.$id},$beenhere, - $encflag,$hdnflag); + $encflag,$hdnflag, $hash); } } } @@ -736,6 +800,7 @@ sub parse_param { # $lpc - Map nesting level (?) # $ispage - True if this resource is encapsulated in a .page (assembled resourcde). # $uri - URI of the enclosing resource. +# $code - CODE for which resource is being parsed (CODEd assignments). # $hash - Reference to the hash we are building. # # Returns: @@ -758,7 +823,7 @@ sub parse_param { # sub parse_resource { - my ($token,$lpc,$ispage,$uri, $hash) = @_; + my ($token,$lpc,$ispage,$uri,$code,$hash) = @_; # I refuse to countenance code like this that has # such a dirty side effect (and forcing this sub to be called within a loop). @@ -904,8 +969,8 @@ sub parse_resource { if (($turi=~/\.sequence$/) || ($turi=~/\.page$/)) { - $hash->{'is_map_'.$rid}=1; - &read_map($turi,$rid, $hash); + $hash->{'is_map_'.$rid}='1'; # String in lonuserstate. + &read_map($turi,$rid,$code,$hash); } return $token->[2]->{'id'}; } @@ -942,7 +1007,7 @@ sub make_link { my $linkid=$lpc.'.'.$linkpc; my $goesto=$lpc.'.'.$to; my $comesfrom=$lpc.'.'.$from; - my $undercond=0; + my $undercond='0'; # If there is a condition, qualify it with the level counter. @@ -1113,7 +1178,8 @@ sub parse_mapalias_param { # $parent_rid - map number qualified id of the parent of the map being read. # For the top level course map this is 0.0. For the first nested # map 1.n where n is the id of the resource within the -# top level map and so on. +# top level map and so on. +# $code - CODE for which map is being read (CODEd assignments). # $hash - Reference to a hash that will become the big hash for the course # This hash is modified as per the map description. # Side-effects: @@ -1123,12 +1189,13 @@ sub parse_mapalias_param { # # sub read_map { - my ($uri, $parent_rid, $hash) = @_; + my ($uri, $parent_rid, $code, $hash) = @_; + # Check for duplication: A map may only be included once. if($hash->{'map_pc_' . $uri}) { - throw Error::Simple('Duplicate map: ' $uri); + throw Error::Simple('Duplicate map: ', $uri); } # count the map number and save it locally so that we don't lose it # when we recurse. @@ -1140,8 +1207,8 @@ sub read_map { # map_pc_uri is the map number of the map with that URI. # map_id_$lmap_no is the URI for this map level. # - $hash->{'map_pc_' . $uri} = $lmap_no; - $hash->{'map_id_' . $lmap_no} = $uri; + $hash->{'map_pc_' . $uri} = "$lmap_no"; # string form in lonuserstate. + $hash->{'map_id_' . $lmap_no} = "$uri"; # Create the path up to the top of the course. # this is in 'map_hierarchy_mapno' that's a comma separated path down to us @@ -1151,7 +1218,7 @@ sub read_map { my $parent_no = $1; # Parent's map number. if (defined($hash->{'map_hierarchy_' . $parent_no})) { $hash->{'map_hierarchy_' . $lmap_no} = - $hash->{'map_hierarchy_' . $parent_no} . ',' $parent_no; + $hash->{'map_hierarchy_' . $parent_no} . ',' . $parent_no; } else { # Only 1 level deep ..nothing to append to: @@ -1164,18 +1231,21 @@ sub read_map { # sorts of files that make sense for this sub my $filename = &Apache::lonnet::filelocation('', &append_version($uri, $hash)); + + my $ispage = ($filename =~/\.page$/); - unless ($ispage || ($filname =~ /\.sequence$/)) { + unless ($ispage || ($filename =~ /\.sequence$/)) { + &Apache::lonnet::logthis("invalid: $filename : $uri"); throw Error::Simple(&mt("
    Invalid map: [_1]", $filename)); } $filename =~ /\.(\w+)$/; - $hash->{'map_type_'.$lpc}=$1; + $hash->{'map_type_'.$lmap_no}=$1; # Repcopy the file and get its contents...report errors if we can't - my $contents = &Apache::lonet::getfile($filename); + my $contents = &Apache::lonnet::getfile($filename); if($contents eq -1) { throw Error::Simple(&mt('
    Map not loaded: The file [_1] does not exist.', $filename)); @@ -1192,7 +1262,7 @@ sub read_map { # tags.. this is because there is no body to a tag. # - my $parser = HTML::TokeParser->new($\contents); + my $parser = HTML::TokeParser->new(\$contents); $parser->attr_encoded(1); # Don't interpret entities in attributes (leave &xyz; alone). while (my $token = $parser->get_token()) { @@ -1207,7 +1277,7 @@ sub read_map { # resources, they are also not processed if random order is turned on. # - $parser = HTML::TokeParser->new($\contents); # no way to reset the existing parser + $parser = HTML::TokeParser->new(\$contents); # no way to reset the existing parser $parser->attr_encoded(1); my $linkpc=0; @@ -1220,7 +1290,7 @@ sub read_map { # Resource if ($token->[1] eq 'resource') { - my $resource_id = &parse_resource($token,$lpc,$ispage,$uri, $hash); + my $resource_id = &parse_resource($token,$lmap_no,$ispage,$uri,$code,$hash); if (defined $resource_id) { push(@map_ids, $resource_id); } @@ -1228,14 +1298,14 @@ sub read_map { # Link } elsif ($token->[1] eq 'link' && !$randomize) { - &make_link(++$linkpc,$lpc,$token->[2]->{'to'}, + &make_link(++$linkpc,$lmap_no,$token->[2]->{'to'}, $token->[2]->{'from'}, $token->[2]->{'condition'}, $hash); # note ..condition may be undefined. # condition } elsif ($token->[1] eq 'condition' && !$randomize) { - &parse_condition($token,$lpc, $hash); + &parse_condition($token,$lmap_no, $hash); } } @@ -1244,7 +1314,7 @@ sub read_map { # if ($randomize) { - if (!$env{'request.role.adv'}) { + if (!&has_advanced_role($username, $userdomain) || $code) { my $seed; # In the advanced role, the map's random seed @@ -1266,7 +1336,11 @@ sub read_map { } - my $rndseed=&Apache::lonnet::rndseed($seed, $username, $userdomain); + my $rndseed=&Apache::lonnet::rndseed($seed, '', + $userdomain, $username, + \%cenv); + + &Apache::lonnet::setup_random_from_rndseed($rndseed); # Take the set of map ids we have decoded and permute them to a @@ -1274,12 +1348,10 @@ sub read_map { # 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; + my $from_rid = $lmap_no.'.'.$from; $hash->{'map_start_'.$uri} = $from_rid; $hash->{'type_'.$from_rid}='start'; @@ -1288,8 +1360,8 @@ sub read_map { # 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; + &make_link(++$linkpc,$lmap_no,$to,$from, 0, $hash); + my $to_rid = $lmap_no.'.'.$to; $hash->{'type_'.$to_rid}='normal'; $from = $to; $from_rid = $to_rid; @@ -1299,6 +1371,7 @@ sub read_map { $hash->{'type_'.$from_rid}='finish'; } + # The last parsing pass parses the tags that associate a name # with resource ids. @@ -1308,7 +1381,7 @@ sub read_map { while (my $token = $parser->get_token) { next if ($token->[0] ne 'S'); if ($token->[1] eq 'param') { - &parse_mapalias_param($token,$lpc, $hash); + &parse_mapalias_param($token,$lmap_no, $hash); } } @@ -1325,6 +1398,7 @@ sub read_map { # $cdom - Domain in which the course is evaluated. # $uname - Name of the user for whom the course is being read # $udom - Name of the domain of the user for whom the course is being read. +# $code - CODE for which course is being read (CODEd assignments) # $target_hash- Reference to the target hash into which all of this is read. # Note tht some of the hash entries we need to build require knowledge of the # course URI.. these are expected to be filled in by the caller. @@ -1333,74 +1407,136 @@ sub read_map { # # sub loadmap { - my ($cnum, $cdom, $uname, $udom, $filepath, $target_hash) = @_; + my ($cnum, $cdom, $uname, $udom, $code, $target_hash) = @_; + - # Clear the auxillary hashes and the cond array. + + # Clear the auxiliary hashes and the cond array. %randompick = (); %randompickseed = (); %encurl = (); %hiddenurl = (); - @cond = (); + %parmhash = (); + @cond = ('true:normal'); # Initial value for cond 0. + $retfrid = ''; + $username = ''; + $userdomain = ''; + %mapalias_cache = (); + %cenv = (); + # $username = $uname; $userdomain = $udom; - my $short_name = $cdom . $cnum; + $short_name = $cdom .'/' . $cnum; + my $retfurl; try { # Get the information we need about the course. - # Return without filling in anything if we can't get any info: - - my %cenv = &Apache::lonnet::coursedesription($short_name, - {'freshen_cache' => 1, - 'user' => $uname}); - unless ($cenv{'url'}) { - &Apache::lonnet::logthis("lonmap::loadmap failed: $cnum/$cdom - did not get url"); - return; - } - $course_id = $cdom . '.' . $cnum; # Long course id. - - # Load the version information into the hash - - + # Return without filling in anything if we can't get any info: + + %cenv = &Apache::lonnet::coursedescription($short_name, + {'freshen_cache' => 1, + 'user' => $uname}); + + unless ($cenv{'url'}) { + &Apache::lonnet::logthis("lonmap::loadmap failed: $cnum/$cdom - did not get url"); + return; + } + + $course_id = $cdom . '_' . $cnum; # Long course id. + + # Load the version information into the hash + + &process_versions(\%cenv, $target_hash); # Figure out the map filename's URI, and set up some starting points for the map. - $course_uri = $cenv->{'url'}; - $map_uri = &Apache::lonnet::clutter($course_uri); + my $course_uri = $cenv{'url'}; + my $map_uri = &Apache::lonnet::clutter($course_uri); $target_hash->{'src_0.0'} = &versiontrack($map_uri, $target_hash); $target_hash->{'title_0.0'} = &Apache::lonnet::metadata($course_uri, 'title'); - $target_hash->{'ids_'.$file_map_uri} = '0.0'; - $target_hash->{'is_map_0.0'} = 1; - &read_map($course_uri, '0.0', &hash); + if(!defined $target_hash->{'title_0.0'}) { + $target_hash->{'title_0.0'} = ''; + } + $target_hash->{'ids_'.$map_uri} = '0.0'; + $target_hash->{'is_map_0.0'} = '1'; + + # In some places we need a username a domain and the courseid...store that + # in the target hash in the context.xxxx keys: + + $target_hash->{'context.username'} = $username; + $target_hash->{'context.userdom'} = $userdomain; + $target_hash->{'context.courseid'} = $course_id; + + + &read_map($course_uri, '0.0', $code, $target_hash); # - if (defined($hash->{'map_start_'.$uri})) { + if (defined($target_hash->{'map_start_'.$map_uri})) { - &traceroute('0',$hash->{'map_start_'.$course_uri},'&', $hash); - &accinit($course_uri, $short_name, $fn, $hash); - &hiddenurls($hash); + &traceroute('0',$target_hash->{'map_start_'.$course_uri},'&', 0, 0, $target_hash); + &accinit($course_uri, $short_name, $target_hash); + &hiddenurls($target_hash); + } + my $errors = &get_mapalias_errors($target_hash); + if ($errors ne "") { + throw Error::Simple("Map alias errors: ", $errors); + } + + # Put the versions in to src: + + foreach my $key (keys(%$target_hash)) { + if ($key =~ /^src_/) { + $target_hash->{$key} = + &putinversion($target_hash->{$key}, $target_hash, $short_name); + } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { + my ($type, $url) = ($1,$2); + my $value = $target_hash->{$key}; + $target_hash->{$type.&putinversion($url, $target_hash, $short_name)}=$value; + } + } + # Mark necrypted URLS. + + foreach my $id (keys(%encurl)) { + $target_hash->{'encrypted_'.$id}=1; } + # Store first keys. + + $target_hash->{'first_rid'}=$retfrid; + my ($mapid,$resid)=split(/\./,$retfrid); + $target_hash->{'first_mapurl'}=$target_hash->{'map_id_'.$mapid}; + my $symb=&Apache::lonnet::encode_symb($target_hash->{'map_id_'.$mapid}, + $resid, + $target_hash->{'src_'.$retfrid}); + $retfurl=&add_get_param($target_hash->{'src_'.$retfrid},{ 'symb' => $symb }); + if ($target_hash->{'encrypted_'.$retfrid}) { + $retfurl=&Apache::lonenc::encrypted($retfurl, + (&Apache::lonnet::allowed('adv') ne 'F')); + } + $target_hash->{'first_url'}=$retfurl; + # Merge in the child hashes in case the caller wants that information as well. - &merge_hash($hash, 'randompick', \%randompick); - &merge_hash($hash, 'randompickseed', \%randompick); - &merge_hash($hash, 'randomorder', \%randomorder); - &merge_hash($hash, 'encurl', \%encurl); - &merge_hash($hash, 'hiddenurl', \%hiddenurl); - &merge_conditions($hash); + &merge_hash($target_hash, 'randompick', \%randompick); + &merge_hash($target_hash, 'randompickseed', \%randompick); + &merge_hash($target_hash, 'randomorder', \%randomorder); + &merge_hash($target_hash, 'encurl', \%encurl); + &merge_hash($target_hash, 'hiddenurl', \%hiddenurl); + &merge_hash($target_hash, 'param', \%parmhash); + &merge_conditions($target_hash); } otherwise { my $e = shift; @@ -1414,7 +1550,7 @@ sub loadmap { # # Module initialization code: -# +# TODO: Fix the pod docs below. 1; __END__