Diff for /loncom/lonmap.pm between versions 1.1 and 1.15

version 1.1, 2011/09/07 10:58:36 version 1.15, 2014/12/11 01:50:27
Line 28 Line 28
 #  #
 ###  ###
   
 package lonmap;  package Apache::lonmap;
 use strict;  use strict;
   
 #------------- Required external modules.  #------------- Required external modules.
Line 38  use Error qw(:try); Line 38  use Error qw(:try);
 use HTML::TokeParser;  use HTML::TokeParser;
   
   
 use Apache::LONCAPA;  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::lonlocal;
   
   use Data::Dumper;
   
   
 #------------- File scoped variables:  #------------- 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.  my $course_id;     # Will be the id of the course being read in.
   
 #  #
Line 56  my %randompickseed; Line 60  my %randompickseed;
 my %randomorder;  my %randomorder;
 my %encurl;  my %encurl;
 my %hiddenurl;  my %hiddenurl;
   my %parmhash;
 my @cond; # Array of conditions.  my @cond; # Array of conditions.
   my $retfrid;
 #  #
 #  Other stuff we make global (sigh) so that it does not need  #  Other stuff we make global (sigh) so that it does not need
 #  to be passed around all the time:  #  to be passed around all the time:
Line 65  my @cond;   # Array of conditions. Line 70  my @cond;   # Array of conditions.
   
 my $username; # User for whom the map is being read.  my $username; # User for whom the map is being read.
 my $userdomain;   # Domain the user lives in.  my $userdomain;   # Domain the user lives in.
   my $short_name; # Course shortname.
 my %mapalias_cache; # Keeps track of map aliases -> resources detects duplicates.  my %mapalias_cache; # Keeps track of map aliases -> resources detects duplicates.
   my %cenv; # Course environment.
   
 #------------- Executable code:   #------------- Executable code: 
   
Line 91  my %mapalias_cache;  # Keeps track of ma Line 98  my %mapalias_cache;  # Keeps track of ma
   
 sub simplify {  sub simplify {
     my $expression=shift;      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  # (0&1) = 1
  $expression=~s/\(0\&([_\.\d]+)\)/$1/g;   $expression=~s/\(0\&([_\.\d]+)\)/$1/g;
 # (8)=8  # (8)=8
Line 111  sub simplify { Line 115  sub simplify {
 # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)  # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
  $expression=~   $expression=~
     s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g;      s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g;
     }  
   
     return $expression;      return $expression;
 }  }
           
Line 128  sub simplify { Line 133  sub simplify {
 sub merge_conditions {  sub merge_conditions {
     my $hash = shift;      my $hash = shift;
   
     for (my $i = 0; i < scalar(@cond); i++) {      for (my $i = 0; $i < scalar(@cond); $i++) {
  $hash->{'condition' . '.' . $i} = $cond[$i];   $hash->{'condition' . '.' . $i} = $cond[$i];
     }      }
 }  }
Line 148  sub merge_conditions { Line 153  sub merge_conditions {
 sub merge_hash {  sub merge_hash {
     my ($parent, $key, $child) = @_;      my ($parent, $key, $child) = @_;
   
     foreach my $childkey (keys (%$child)) {      if ($key ne '') {
  $parent->{$key . '.' . $childkey} = $child->{$childkey};   $key .= '.'; # If we are prefixing, prefix then .
       }
   
       foreach my $childkey (keys(%$child)) {
    $parent->{$key . $childkey} = $child->{$childkey};
     }      }
 }  }
   
Line 181  sub count_mapalias { Line 190  sub count_mapalias {
 #  result string.'  #  result string.'
 #  #
 #  Parameters:  #  Parameters:
 #     none  #     hash - Reference to the hash we are trying t build up.
 #  Implicit inputs  #  Implicit inputs
 #     %mapalias - a hash that is indexed by map aliases and contains for each key  #     %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'.  #                 an array of the resource id's the alias 'points to'.
Line 191  sub count_mapalias { Line 200  sub count_mapalias {
 #  #
 #  #
 sub get_mapalias_errors {  sub get_mapalias_errors {
       my $hash = shift;
     my $error_text;      my $error_text;
     foreach my $mapalias (sort(keys(%mapalias_cache))) {      foreach my $mapalias (sort(keys(%mapalias_cache))) {
  next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);   next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);
Line 199  sub get_mapalias_errors { Line 209  sub get_mapalias_errors {
     join('</li><li>',       join('</li><li>', 
  map {   map {
      my $id = $_;       my $id = $_;
      if (exists($hash{'src_'.$id})) {       if (exists($hash->{'src_'.$id})) {
  $count++;   $count++;
      }       }
      my ($mapid) = split(/\./,$id);       my ($mapid) = split(/\./,$id);
      &mt('Resource "[_1]" <br /> in Map "[_2]"',       &mt('Resource [_1][_2]in Map [_3]',
  $hash{'title_'.$id},   '"'.$hash->{'title_'.$id}.'"',
  $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});                           '<br />',
    '"'.$hash->{'title_'.$hash->{'ids_'.$hash->{'map_id_'.$mapid}}}.'"');
  } (@{ $mapalias_cache{$mapalias} }));   } (@{ $mapalias_cache{$mapalias} }));
  next if ($count < 2);   next if ($count < 2);
  $error_text .= '<div class="LC_error">'.   $error_text .= '<div class="LC_error">'.
Line 229  sub clear_mapalias_count { Line 240  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.  #  Create hash entries for each version of the course.
 # Parameters:  # Parameters:
 #   $cenv    - Reference to a course environment from lonnet::coursedescription.  #   $cenv    - Reference to a course environment from lonnet::coursedescription.
Line 243  sub process_versions { Line 279  sub process_versions {
  $cenv->{'domain'},   $cenv->{'domain'},
  $cenv->{'num'});   $cenv->{'num'});
   
     foreach my $ver (keys (%versions)) {      foreach my $ver (keys(%versions)) {
  if ($ver =~/^error\:/) { # lonc/lond transaction failed.   if ($ver =~/^error\:/) { # lonc/lond transaction failed.
     throw Error::Simple('lonc/lond returned error: ' . $ver);      throw Error::Simple('lonc/lond returned error: ' . $ver);
  }   }
Line 260  sub process_versions { Line 296  sub process_versions {
 #  #
 sub versionerror {  sub versionerror {
     my ($uri, $used, $unused) = @_;      my ($uri, $used, $unused) = @_;
     my ($uri,$usedversion,$unusedversion)=@_;  
     return '<br />'.      return '<br />'.
  &mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].',   &mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].',
     $uri,$used,$unused).'<br />';      $uri,$used,$unused).'<br />';
Line 281  sub versionerror { Line 316  sub versionerror {
 # Returns:  # Returns:
 #   URI with the version cut out.  #   URI with the version cut out.
 #  #
 sub vesiontrack {  sub versiontrack {
     my ($uri, $hash) = @_;      my ($uri, $hash) = @_;
   
   
Line 291  sub vesiontrack { Line 326  sub vesiontrack {
         unless ($hash->{'version_'.$uri}) {          unless ($hash->{'version_'.$uri}) {
     $hash->{'version_'.$uri}=$version;      $hash->{'version_'.$uri}=$version;
  } elsif ($version!=$hash->{'version_'.$uri}) {   } 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;      return $uri;
Line 339  sub append_version { Line 374  sub append_version {
     return $uri;      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:  # Post processing subs:
 sub hiddenurls {  sub hiddenurls {
     my $hash = shift;      my $hash = shift;
   
       my $uname    = $hash->{'context.username'};
       my $udom     = $hash->{'context.userdom'};
       my $courseid = $hash->{'context.courseid'};
   
     my $randomoutentry='';      my $randomoutentry='';
     foreach my $rid (keys %randompick) {      foreach my $rid (keys(%randompick)) {
         my $rndpick=$randompick{$rid};          my $rndpick=$randompick{$rid};
         my $mpc=$hash->{'map_pc_'.$hash->{'src_'.$rid}};          my $mpc=$hash->{'map_pc_'.$hash->{'src_'.$rid}};
 # ------------------------------------------- put existing resources into array  # ------------------------------------------- put existing resources into array
Line 366  sub hiddenurls { Line 431  sub hiddenurls {
 # -------------------------------- randomly eliminate the ones that should stay  # -------------------------------- randomly eliminate the ones that should stay
  my (undef,$id)=split(/\./,$rid);   my (undef,$id)=split(/\./,$rid);
         if ($randompickseed{$rid}) { $id=$randompickseed{$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);   &Apache::lonnet::setup_random_from_rndseed($rndseed);
  my @whichids=&Math::Random::random_permuted_index($#currentrids+1);   my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
         for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }          for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
  #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids));  
 # -------------------------------------------------------- delete the leftovers  # -------------------------------------------------------- delete the leftovers
         for (my $k=0; $k<=$#currentrids; $k++) {          for (my $k=0; $k<=$#currentrids; $k++) {
             if ($currentrids[$k]) {              if ($currentrids[$k]) {
  $hash->{'randomout_'.$currentrids[$k]}=1;   $hash->{'randomout_'.$currentrids[$k]}='1';
                 my ($mapid,$resid)=split(/\./,$currentrids[$k]);                  my ($mapid,$resid)=split(/\./,$currentrids[$k]);
                 $randomoutentry.='&'.                  $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},      &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},
Line 385  sub hiddenurls { Line 450  sub hiddenurls {
         }          }
     }      }
 # ------------------------------ take care of explicitly hidden urls or folders  # ------------------------------ take care of explicitly hidden urls or folders
     foreach my $rid (keys %hiddenurl) {      foreach my $rid (keys(%hiddenurl)) {
  $hash->{'randomout_'.$rid}=1;   $hash->{'randomout_'.$rid}='1';
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
  $randomoutentry.='&'.   $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid,      &Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid,
Line 410  sub hiddenurls { Line 475  sub hiddenurls {
 #         #       
   
 sub accinit {  sub accinit {
     my ($uri,$short,$fn)=@_;      my ($uri, $short, $hash)=@_;
     my %acchash=();      my %acchash=();
     my %captured=();      my %captured=();
     my $condcounter=0;      my $condcounter=0;
Line 542  sub accinit { Line 607  sub accinit {
 #    new value indicating how far the map has been traversed (the sofar).  #    new value indicating how far the map has been traversed (the sofar).
 #  #
 sub traceroute {  sub traceroute {
     my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;      my ($sofar, $rid, $beenhere, $encflag, $hdnflag, $hash)=@_;
     my $newsofar=$sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
   
     unless ($beenhere=~/\&\Q$rid\E\&/) {      unless ($beenhere=~/\&\Q$rid\E\&/) {
Line 551  sub traceroute { Line 616  sub traceroute {
  my $symb=&Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid,   my $symb=&Apache::lonnet::encode_symb($hash->{'map_id_'.$mapid},$resid,
       $hash->{'src_'.$rid});        $hash->{'src_'.$rid});
  my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);   my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
           my $ignorehidden;
   
  if ($hdnflag || lc($hidden) eq 'yes') {   if ($hdnflag || lc($hidden) eq 'yes') {
     $hiddenurl{$rid}=1;              if (defined($hash->{'is_map_'.$rid})) {
                   if (($hash->{'context.nohideurl'}) && ($hash->{'context.nohideurl'} eq $hash->{'src_'.$rid})) {
                       $ignorehidden = 1; # Hidden parameter explicitly deleted 
                                          # if printing/grading bubblesheet exam
                   }
               }
               unless ($ignorehidden) {
           $hiddenurl{$rid}=1;
               }
  }   }
  if (!$hdnflag && lc($hidden) eq 'no') {   if (!$hdnflag && lc($hidden) eq 'no') {
     delete($hiddenurl{$rid});      delete($hiddenurl{$rid});
Line 583  sub traceroute { Line 657  sub traceroute {
   
  if (defined($hash->{'is_map_'.$rid})) {   if (defined($hash->{'is_map_'.$rid})) {
     if (defined($hash->{'map_start_'.$hash->{'src_'.$rid}})) {      if (defined($hash->{'map_start_'.$hash->{'src_'.$rid}})) {
                   my $maphidden;
                   unless ($ignorehidden) {
                       $maphidden = $hdnflag || $hiddenurl{$rid};
                   }
  $sofar=$newsofar=   $sofar=$newsofar=
     &traceroute($sofar,      &traceroute($sofar,
  $hash->{'map_start_'.$hash->{'src_'.$rid}},   $hash->{'map_start_'.$hash->{'src_'.$rid}},
  $beenhere,   $beenhere,
  $encflag || $encurl{$rid},   $encflag || $encurl{$rid},
  $hdnflag || $hiddenurl{$rid});   $maphidden, $hash);
     }      }
  }   }
   
Line 608  sub traceroute { Line 686  sub traceroute {
  $further=simplify('('.'_'.$rid.')&('.   $further=simplify('('.'_'.$rid.')&('.
   $hash->{'condid_'.$hash->{'undercond_'.$id}}.')');    $hash->{'condid_'.$hash->{'undercond_'.$id}}.')');
     } else {      } else {
  $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash->{'undercond_'.$id});   my $errtext.='<br />'.&mt('Undefined condition ID: [_1]',$hash->{'undercond_'.$id});
  throw Error::Simple($errtext);   throw Error::Simple($errtext);
     }      }
                 }                  }
  #  Recurse to resoruces that have to's to us.   #  Recurse to resoruces that have to's to us.
                 $newsofar=&traceroute($further,$hash->{'goesto_'.$id},$beenhere,                  $newsofar=&traceroute($further,$hash->{'goesto_'.$id},$beenhere,
       $encflag,$hdnflag);        $encflag,$hdnflag, $hash);
     }      }
  }   }
     }      }
Line 718  sub parse_param { Line 796  sub parse_param {
     $hiddenurl{$referid}=1;      $hiddenurl{$referid}=1;
  }   }
     }      }
   
 }  }
   
   
Line 736  sub parse_param { Line 813  sub parse_param {
 #    $lpc     - Map nesting level (?)  #    $lpc     - Map nesting level (?)
 #    $ispage  - True if this resource is encapsulated in a .page (assembled resourcde).  #    $ispage  - True if this resource is encapsulated in a .page (assembled resourcde).
 #    $uri     - URI of the enclosing resource.  #    $uri     - URI of the enclosing resource.
   #    $code    - CODE for which resource is being parsed (CODEd assignments).
 #    $hash    - Reference to the hash we are building.  #    $hash    - Reference to the hash we are building.
 #  #
 # Returns:  # Returns:
Line 758  sub parse_param { Line 836  sub parse_param {
 #  #
   
 sub parse_resource {  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       # I refuse to countenance code like this that has 
     # such a dirty side effect (and forcing this sub to be called within a loop).      # such a dirty side effect (and forcing this sub to be called within a loop).
Line 904  sub parse_resource { Line 982  sub parse_resource {
           
     if (($turi=~/\.sequence$/) ||      if (($turi=~/\.sequence$/) ||
  ($turi=~/\.page$/)) {   ($turi=~/\.page$/)) {
  $hash->{'is_map_'.$rid}=1;   $hash->{'is_map_'.$rid}='1'; # String in lonuserstate.
  &read_map($turi,$rid, $hash);          if ($hiddenurl{$rid}) {
               if (($hash->{'context.nohideurl'}) &&
                   ($hash->{'context.nohideurl'} eq $hash->{'src_'.$rid})) {
                   delete($hiddenurl{$rid}); # Hidden parameter explicitly deleted
                                             # if printing/grading bubblesheet exam  
               }
           }
   
    &read_map($turi,$rid,$code,$hash);
     }       } 
     return $token->[2]->{'id'};      return $token->[2]->{'id'};
 }  }
Line 942  sub make_link { Line 1028  sub make_link {
     my $linkid=$lpc.'.'.$linkpc;      my $linkid=$lpc.'.'.$linkpc;
     my $goesto=$lpc.'.'.$to;      my $goesto=$lpc.'.'.$to;
     my $comesfrom=$lpc.'.'.$from;      my $comesfrom=$lpc.'.'.$from;
     my $undercond=0;      my $undercond='0';
   
   
     # If there is a condition, qualify it with the level counter.      # If there is a condition, qualify it with the level counter.
Line 1113  sub parse_mapalias_param { Line 1199  sub parse_mapalias_param {
 #   $parent_rid  - map number qualified id of the parent of the map being read.  #   $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  #                  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  #                  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  #   $hash        - Reference to a hash that will become the big hash for the course
 #                  This hash is modified as per the map description.  #                  This hash is modified as per the map description.
 # Side-effects:  # Side-effects:
Line 1123  sub parse_mapalias_param { Line 1210  sub parse_mapalias_param {
 #  #
 #    #  
 sub read_map {  sub read_map {
     my ($uri, $parent_rid, $hash) = @_;      my ($uri, $parent_rid, $code, $hash) = @_;
   
   
     # Check for duplication: A map may only be included once.      # Check for duplication: A map may only be included once.
   
     if($hash->{'map_pc_' . $uri}) {      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      # count the map number and save it locally so that we don't lose it
     # when we recurse.      # when we recurse.
Line 1140  sub read_map { Line 1228  sub read_map {
     #  map_pc_uri is the map number of the map with that URI.      #  map_pc_uri is the map number of the map with that URI.
     #  map_id_$lmap_no is the URI for this map level.      #  map_id_$lmap_no is the URI for this map level.
     #      #
     $hash->{'map_pc_' . $uri}     = $lmap_no;      $hash->{'map_pc_' . $uri}     = "$lmap_no"; # string form in lonuserstate.
     $hash->{'map_id_' . $lmap_no} = $uri;      $hash->{'map_id_' . $lmap_no} = "$uri";
   
     # Create the path up to the top of the course.      # 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      # this is in 'map_hierarchy_mapno'  that's a comma separated path down to us
Line 1151  sub read_map { Line 1239  sub read_map {
  my $parent_no = $1;       # Parent's map number.   my $parent_no = $1;       # Parent's map number.
  if (defined($hash->{'map_hierarchy_' . $parent_no})) {   if (defined($hash->{'map_hierarchy_' . $parent_no})) {
     $hash->{'map_hierarchy_' . $lmap_no} =      $hash->{'map_hierarchy_' . $lmap_no} =
  $hash->{'map_hierarchy_' . $parent_no} . ',' $parent_no;   $hash->{'map_hierarchy_' . $parent_no} . ',' . $parent_no;
  } else {   } else {
     # Only 1 level deep ..nothing to append to:      # Only 1 level deep ..nothing to append to:
   
Line 1164  sub read_map { Line 1252  sub read_map {
     # sorts of files that make sense for this sub       # sorts of files that make sense for this sub 
   
     my $filename = &Apache::lonnet::filelocation('', &append_version($uri, $hash));      my $filename = &Apache::lonnet::filelocation('', &append_version($uri, $hash));
   
   
     my $ispage = ($filename =~/\.page$/);      my $ispage = ($filename =~/\.page$/);
     unless ($ispage || ($filname =~ /\.sequence$/)) {      unless ($ispage || ($filename =~ /\.sequence$/)) {
  throw Error::Simple(&mt("<br />Invalid map: <tt>[_1]</tt>", $filename));   &Apache::lonnet::logthis("invalid: $filename : $uri");
    throw Error::Simple('<br />'.&mt('Invalid map: [_1]','<span class="LC_filename">'.$filename.'</span>'));
     }      }
   
     $filename =~ /\.(\w+)$/;      $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      # 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) {      if($contents eq -1) {
         throw Error::Simple(&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',          throw Error::Simple('<br />'.&mt('Map not loaded: The file [_1] does not exist.',
  $filename));   '<span class="LC_filename">'.$filename.'</span>'));
     }      }
     # Now that we succesfully retrieved the file we can make our parsing passes over it:      # Now that we succesfully retrieved the file we can make our parsing passes over it:
     # parsing is done in passes:      # parsing is done in passes:
Line 1192  sub read_map { Line 1283  sub read_map {
     # tags.. this is because there is no body to a <param> tag.      # tags.. this is because there is no body to a <param> 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).      $parser->attr_encoded(1); # Don't interpret entities in attributes (leave &xyz; alone).
   
     while (my $token = $parser->get_token()) {      while (my $token = $parser->get_token()) {
Line 1207  sub read_map { Line 1298  sub read_map {
     # resources, they are also not processed if random order is turned on.      # 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);      $parser->attr_encoded(1);
   
     my $linkpc=0;      my $linkpc=0;
Line 1220  sub read_map { Line 1311  sub read_map {
  # Resource   # Resource
   
  if ($token->[1] eq '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) {      if (defined $resource_id) {
  push(@map_ids, $resource_id);    push(@map_ids, $resource_id); 
     }      }
Line 1228  sub read_map { Line 1319  sub read_map {
        # Link         # Link
   
  } elsif ($token->[1] eq 'link' && !$randomize) {   } 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]->{'from'},
        $token->[2]->{'condition'}, $hash); # note ..condition may be undefined.         $token->[2]->{'condition'}, $hash); # note ..condition may be undefined.
   
  # condition   # condition
   
  } elsif ($token->[1] eq 'condition' && !$randomize) {   } elsif ($token->[1] eq 'condition' && !$randomize) {
     &parse_condition($token,$lpc, $hash);      &parse_condition($token,$lmap_no, $hash);
  }   }
     }      }
   
Line 1244  sub read_map { Line 1335  sub read_map {
     #       # 
   
     if ($randomize) {      if ($randomize) {
  if (!$env{'request.role.adv'}) {   if (!&has_advanced_role($username, $userdomain) || $code) {
     my $seed;      my $seed;
   
     # In the advanced role, the map's random seed      # In the advanced role, the map's random seed
Line 1266  sub read_map { Line 1357  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);      &Apache::lonnet::setup_random_from_rndseed($rndseed);
   
     # Take the set of map ids we have decoded and permute them to a      # Take the set of map ids we have decoded and permute them to a
Line 1274  sub read_map { Line 1369  sub read_map {
     # processing the randomorder parameter if it is set, not      # processing the randomorder parameter if it is set, not
     # randompick.      # randompick.
   
     @map_ids=&math::Random::random_permutation(@map_ids);       @map_ids=&Math::Random::random_permutation(@map_ids); 
  }   }
   
   
  my $from = shift(@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->{'map_start_'.$uri} = $from_rid;
  $hash->{'type_'.$from_rid}='start';   $hash->{'type_'.$from_rid}='start';
   
Line 1288  sub read_map { Line 1381  sub read_map {
  # if randomorder was set.  This means that for an instructor to choose   # if randomorder was set.  This means that for an instructor to choose
   
  while (my $to = shift(@map_ids)) {   while (my $to = shift(@map_ids)) {
     &make_link(++$linkpc,$lpc,$to,$from);      &make_link(++$linkpc,$lmap_no,$to,$from, 0, $hash);
     my $to_rid =  $lpc.'.'.$to;      my $to_rid =  $lmap_no.'.'.$to;
     $hash->{'type_'.$to_rid}='normal';      $hash->{'type_'.$to_rid}='normal';
     $from = $to;      $from = $to;
     $from_rid = $to_rid;      $from_rid = $to_rid;
Line 1299  sub read_map { Line 1392  sub read_map {
  $hash->{'type_'.$from_rid}='finish';   $hash->{'type_'.$from_rid}='finish';
     }      }
   
   
     #  The last parsing pass parses the <mapalias> tags that associate a name      #  The last parsing pass parses the <mapalias> tags that associate a name
     #  with resource ids.      #  with resource ids.
   
Line 1308  sub read_map { Line 1402  sub read_map {
     while (my $token = $parser->get_token) {      while (my $token = $parser->get_token) {
  next if ($token->[0] ne 'S');   next if ($token->[0] ne 'S');
  if ($token->[1] eq 'param') {   if ($token->[1] eq 'param') {
     &parse_mapalias_param($token,$lpc, $hash);        &parse_mapalias_param($token,$lmap_no, $hash);  
  }    } 
     }      }
   
Line 1325  sub read_map { Line 1419  sub read_map {
 #    $cdom       - Domain in which the course is evaluated.  #    $cdom       - Domain in which the course is evaluated.
 #    $uname      - Name of the user for whom the course is being read  #    $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.  #    $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)
   #    $nohideurl  - URL for an exam folder for which hidden state is to be ignored.
 #    $target_hash- Reference to the target hash into which all of this is read.  #    $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  #                  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.  #                  course URI.. these are expected to be filled in by the caller.
Line 1333  sub read_map { Line 1429  sub read_map {
 #  #
 #    #  
 sub loadmap {  sub loadmap {
     my ($cnum, $cdom, $uname, $udom, $filepath, $target_hash) = @_;      my ($cnum, $cdom, $uname, $udom, $code, $nohideurl, $target_hash) = @_;
   
   
   
     # Clear the auxillary hashes and the cond array.      # Clear the auxiliary hashes and the cond array.
   
   
     %randompick     = ();      %randompick     = ();
     %randompickseed = ();      %randompickseed = ();
     %encurl         = ();      %encurl         = ();
     %hiddenurl      = ();      %hiddenurl      = ();
     @cond           = ();      %parmhash       = ();
       @cond           = ('true:normal'); # Initial value for cond 0.
       $retfrid        = '';
       $username       = '';
       $userdomain     = '';
       %mapalias_cache = ();
       %cenv           = ();
       $map_number     =  0;
       
     #       # 
   
     $username   = $uname;      $username   = $uname;
     $userdomain = $udom;      $userdomain = $udom;
   
     my $short_name = $cdom . $cnum;      $short_name = $cdom .'/' . $cnum;
       my $retfurl;
   
     try {      try {
   
   
  # Get the information we need about the course.   # Get the information we need about the course.
  # Return without filling in anything if we can't get any info:    # Return without filling in anything if we can't get any info:
    
  my %cenv = &Apache::lonnet::coursedesription($short_name,    %cenv = &Apache::lonnet::coursedescription($short_name,
      {'freshen_cache' => 1,        {'freshen_cache' => 1,
       'user'          => $uname});          'user'          => $uname}); 
  unless ($cenv{'url'}) {    
     &Apache::lonnet::logthis("lonmap::loadmap failed: $cnum/$cdom - did not get url");    unless ($cenv{'url'}) {
     return;        &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    $course_id = $cdom . '_' . $cnum; # Long course id.
    
     # Load the version information into the hash
    
    
  &process_versions(\%cenv, $target_hash);   &process_versions(\%cenv, $target_hash);
   
   
  # Figure out the map filename's URI, and set up some starting points for the map.   # Figure out the map filename's URI, and set up some starting points for the map.
   
  $course_uri = $cenv->{'url'};   my $course_uri = $cenv{'url'};
  $map_uri    = &Apache::lonnet::clutter($course_uri);   my $map_uri    = &Apache::lonnet::clutter($course_uri);
   
  $target_hash->{'src_0.0'}            = &versiontrack($map_uri, $target_hash);    $target_hash->{'src_0.0'}            = &versiontrack($map_uri, $target_hash); 
  $target_hash->{'title_0.0'}          = &Apache::lonnet::metadata($course_uri, 'title');   $target_hash->{'title_0.0'}          = &Apache::lonnet::metadata($course_uri, 'title');
  $target_hash->{'ids_'.$file_map_uri} = '0.0';   if(!defined $target_hash->{'title_0.0'}) {
  $target_hash->{'is_map_0.0'}         = 1;      $target_hash->{'title_0.0'} = '';
         &read_map($course_uri, '0.0', &hash);   }
    $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:
   
  if (defined($hash->{'map_start_'.$uri})) {   $target_hash->{'context.username'} = $username;
    $target_hash->{'context.userdom'}  = $userdomain;
    $target_hash->{'context.courseid'} = $course_id;
    
           # When grading or printing a bubblesheet exam ignore
           # "hidden" parameter set in the map containing the exam folder.
           $target_hash->{'context.nohideurl'} = $nohideurl;
   
           &read_map($course_uri, '0.0', $code, $target_hash);
   
    if (defined($target_hash->{'map_start_'.$map_uri})) {
   
       &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.
   
     &traceroute('0',$hash->{'map_start_'.$course_uri},'&', $hash);   foreach my $id (keys(%encurl)) {
     &accinit($course_uri, $short_name, $fn, $hash);      $target_hash->{'encrypted_'.$id}=1;
     &hiddenurls($hash);  
  }   }
   
    # 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 in the child hashes in case the caller wants that information as well.
   
   
  &merge_hash($hash, 'randompick', \%randompick);   &merge_hash($target_hash, 'randompick', \%randompick);
  &merge_hash($hash, 'randompickseed', \%randompick);   &merge_hash($target_hash, 'randompickseed', \%randompickseed);
  &merge_hash($hash, 'randomorder', \%randomorder);   &merge_hash($target_hash, 'randomorder', \%randomorder);
  &merge_hash($hash, 'encurl', \%encurl);   &merge_hash($target_hash, 'encurl', \%encurl);
  &merge_hash($hash, 'hiddenurl', \%hiddenurl);   &merge_hash($target_hash, 'hiddenurl', \%hiddenurl);
  &merge_conditions($hash);   &merge_hash($target_hash, 'param', \%parmhash);
    &merge_conditions($target_hash);
     }      }
     otherwise {      otherwise {
  my $e = shift;   my $e = shift;
Line 1414  sub loadmap { Line 1573  sub loadmap {
   
 #  #
 #  Module initialization code:  #  Module initialization code:
 #  #  TODO:  Fix the pod docs below.
   
 1;  1;
 __END__  __END__
Line 1425  Apache::lonmap - Construct a hash that r Line 1584  Apache::lonmap - Construct a hash that r
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 &Apache::lonmap::loadmap($filepath, \%target_hash);  &Apache::lonmap::loadmap($cnum, $cdom, $uname, $udom, $code, $nohideurl, \%target_hash);
   
 =head1 INTRODUCTION  =head1 INTRODUCTION
   
 This module reads a course filename into a hash reference.  It's up to the caller  This module reads a course filename into a hash reference.  It's up to the caller
 to to things like decide the has should be tied to some external file and handle the locking  to do things like decide that the hash should be tied to some external file and handle the
 if this file should be shared amongst several Apache children.  the locking if this file should be shared amongst several Apache children.
   
 =head1 SUBROUTINES  =head1 SUBROUTINES
   
 =over  =over
   
 =item loadmap($filepath, $targethash)  =item loadmap($cnum, $cdom, $uname, $udom, $code, $nohideurl, $targethash)
   
   
 Reads the map file into a target hash.  Reads the top-level map file into a target hash. This is done by first parsing the
   map file into local hashes and then unrolling those hashes into the big hash.
   
 =over  =over
   
 =item $filepath - The path to the map file to read.  =item $cnum - number of course being read.
   
   =item $cdom - domain in which the course is evaluated.
   
   =item $uname - name of the user for whom the course is being read.
   
   =item $udom  - name of the domain of the user for whom the course is being read.
   
   =item $code  - CODE for which course is being read (CODEd assignments).
   
   =item $nohideurl - URL for an exam folder for which hidden state is to be ignored.
   
 =item $targethash - A reference to hash into which the course is read.  =item $targethash - A reference to hash into which the course is read
   
 =back  =back
   

Removed from v.1.1  
changed lines
  Added in v.1.15


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>