Diff for /rat/lonuserstate.pm between versions 1.125 and 1.169

version 1.125, 2007/10/16 21:14:53 version 1.169, 2022/10/04 20:39:57
Line 42  use Safe::Hole; Line 42  use Safe::Hole;
 use Opcode;  use Opcode;
 use Apache::lonenc;  use Apache::lonenc;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   use File::Basename;
   
     
   
 # ---------------------------------------------------- Globals for this package  # ---------------------------------------------------- Globals for this package
   
 my $pc;      # Package counter  my $pc;      # Package counter is this what 'Guts' calls the map counter?
 my %hash;    # The big tied hash  my %hash;    # The big tied hash
 my %parmhash;# The hash with the parameters  my %parmhash;# The hash with the parameters
 my @cond;    # Array with all of the conditions  my @cond;    # Array with all of the conditions
Line 57  my $retfurl; # first URL Line 59  my $retfurl; # first URL
 my %randompick; # randomly picked resources  my %randompick; # randomly picked resources
 my %randompickseed; # optional seed for randomly picking resources  my %randompickseed; # optional seed for randomly picking resources
 my %randomorder; # maps to order contents randomly  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 %encurl; # URLs in this folder are supposed to be encrypted
 my %hiddenurl; # this URL (or complete folder) is supposed to be hidden  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  # ----------------------------------- Remove version from URL and store in hash
   
   sub versionerror {
       my ($uri,$usedversion,$unusedversion)=@_;
       return '<br />'.&mt('Version discrepancy: resource [_1] included in both version [_2] and version [_3]. Using version [_2].',
                       $uri,$usedversion,$unusedversion).'<br />';
   }
   
   #  Removes the version number from a URI and returns the resulting
   #  URI (e.g. mumbly.version.stuff => mumbly.stuff).
   #
   #   If the URI has not been seen with a versio before the
   #   hash{'version_'.resultingURI} is set to the  version number.
   #   If the URI has been seen and the version does not match and error
   #   is added to the error string.
   #
   # Parameters:
   #   URI potentially with a version.
   # Returns:
   #   URI with the version cut out.
   # See above for side effects.
   #
   
 sub versiontrack {  sub versiontrack {
     my $uri=shift;      my $uri=shift;
     if ($uri=~/\.(\d+)\.\w+$/) {      if ($uri=~/\.(\d+)\.\w+$/) {
Line 69  sub versiontrack { Line 96  sub versiontrack {
  $uri=~s/\.\d+\.(\w+)$/\.$1/;   $uri=~s/\.\d+\.(\w+)$/\.$1/;
         unless ($hash{'version_'.$uri}) {          unless ($hash{'version_'.$uri}) {
     $hash{'version_'.$uri}=$version;      $hash{'version_'.$uri}=$version;
  }   } elsif ($version!=$hash{'version_'.$uri}) {
               $errtext.=&versionerror($uri,$hash{'version_'.$uri},$version);
           }
     }      }
     return $uri;      return $uri;
 }  }
Line 104  sub processversionfile { Line 133  sub processversionfile {
     }      }
 }  }
   
 # --------------------------------------------------------- Loads map from disk  # --------------------------------------------------------- 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 {   sub loadmap { 
     my ($uri,$parent_rid)=@_;      my ($uri,$parent_rid,$courseid)=@_;
   
       # Is the map already included?
   
     if ($hash{'map_pc_'.$uri}) {       if ($hash{'map_pc_'.$uri}) { 
  $errtext.='<p class="LC_error">'.   $errtext.='<p class="LC_error">'.
     &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').      &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
     '</p>';      '</p>';
  return;    return; 
     }      }
       # Register the resource in it's map_pc_ [for the URL]
       # map_id.nnn is the nesting level -> to the URI.
   
     $pc++;      $pc++;
     my $lpc=$pc;      my $lpc=$pc;
     $hash{'map_pc_'.$uri}=$lpc;      $hash{'map_pc_'.$uri}=$lpc;
     $hash{'map_id_'.$lpc}=$uri;      $hash{'map_id_'.$lpc}=$uri;
   
 # Determine and check filename      # If the parent is of the form n.m hang this map underneath it in the
       # map hierarchy.
   
       if ($parent_rid =~ /^(\d+)\.\d+$/) {
           my $parent_pc = $1;
           if (defined($hash{'map_hierarchy_'.$parent_pc})) {
               $hash{'map_hierarchy_'.$lpc}=$hash{'map_hierarchy_'.$parent_pc}.','.
                                            $parent_pc;
           } else {
               $hash{'map_hierarchy_'.$lpc}=$parent_pc;
           }
       }
   
   # Determine and check filename of the sequence we need to read:
   
     my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));      my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));
   
     my $ispage=($fn=~/\.page$/);      my $ispage=($fn=~/\.page$/);
   
     unless (($fn=~/\.sequence$/) ||      # We can only nest sequences or pages.  Anything else is an illegal nest.
             ($fn=~/\.page$/)) {   
  $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);      unless (($fn=~/\.sequence$/) || $ispage) { 
    $errtext.='<br />'.&mt('Invalid map: [_1]',"<tt>$fn</tt>");
  return;    return; 
     }      }
   
       # Read the XML that constitutes the file.
   
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
   
     if ($instr eq -1) {      if ($instr eq -1) {
         $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);          $errtext.= '<br />'
                     .&mt('Map not loaded: The file [_1] does not exist.',
                          "<tt>$fn</tt>");
           $hash{'map_type_'.$lpc}='none';
           if (&is_advanced($courseid)) {
               $errtext .= &error_detail($parent_rid,$courseid,$ispage,$uri);
           }
  return;   return;
     }      }
   
 # Successfully got file, parse it      # Successfully got file, parse it
   
       # parse for parameter processing.
       # Note that these are <param... / > tags
       # so we only care about 'S' (tag start) nodes.
   
   
     my $parser = HTML::TokeParser->new(\$instr);      my $parser = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
   
     # first get all parameters      # first get all parameters
   
   
     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_param($token,$lpc);      &parse_param($token,$lpc);
  }    } 
     }      }
     #reset parser  
       # Get set to take another pass through the XML:
       # for resources and links.
   
     $parser = HTML::TokeParser->new(\$instr);      $parser = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
   
Line 160  sub loadmap { Line 240  sub loadmap {
   
     my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);      my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
   
       # Parse the resources, link and condition tags.
       # Note that if randomorder or random select is chosen the links and
       # conditions are meaningless but are determined by the randomization.
       # This is handled in the next chunk of code.
   
     my @map_ids;      my @map_ids;
       my $codechecked;
       $rescount{$lpc} = 0;
       $mapcount{$lpc} = 0;
     while (my $token = $parser->get_token) {      while (my $token = $parser->get_token) {
  next if ($token->[0] ne 'S');   next if ($token->[0] ne 'S');
   
    # Resource
   
  if ($token->[1] eq 'resource') {   if ($token->[1] eq 'resource') {
     push(@map_ids,&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);
                   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
   
  } elsif ($token->[1] eq 'link' && !$randomize) {   } elsif ($token->[1] eq 'link' && !$randomize) {
 # ----------------------------------------------------------------------- Links  
     &make_link(++$linkpc,$lpc,$token->[2]->{'to'},      &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
        $token->[2]->{'from'},         $token->[2]->{'from'},
        $token->[2]->{'condition'});         $token->[2]->{'condition'}); # note ..condition may be undefined.
   
    # condition
   
  } elsif ($token->[1] eq 'condition' && !$randomize) {   } elsif ($token->[1] eq 'condition' && !$randomize) {
     &parse_condition($token,$lpc);      &parse_condition($token,$lpc);
  }   }
     }      }
       undef($codechecked);
   
       # Handle randomization and random selection
   
     if ($randomize) {      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;      my $seed;
   
               # 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})) {      if (defined($randompickseed{$parent_rid})) {
  $seed = $randompickseed{$parent_rid};   $seed = $randompickseed{$parent_rid};
     } else {      } else {
   
    # Otherwise the parent's fully encoded symb is used.
   
  my ($mapid,$resid)=split(/\./,$parent_rid);   my ($mapid,$resid)=split(/\./,$parent_rid);
  my $symb=   my $symb=
     &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
Line 188  sub loadmap { Line 317  sub loadmap {
   
  $seed = $symb;   $seed = $symb;
     }      }
   
       # 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);      my $rndseed=&Apache::lonnet::rndseed($seed);
     &Apache::lonnet::setup_random_from_rndseed($rndseed);      &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 = shift(@map_ids);
  my $from_rid = $lpc.'.'.$from;   my $from_rid = $lpc.'.'.$from;
  $hash{'map_start_'.$uri} = $from_rid;   $hash{'map_start_'.$uri} = $from_rid;
  $hash{'type_'.$from_rid}='start';   $hash{'type_'.$from_rid}='start';
   
    # 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)) {   while (my $to = shift(@map_ids)) {
     &make_link(++$linkpc,$lpc,$to,$from);      &make_link(++$linkpc,$lpc,$to,$from);
     my $to_rid =  $lpc.'.'.$to;      my $to_rid =  $lpc.'.'.$to;
Line 210  sub loadmap { Line 366  sub loadmap {
  $hash{'type_'.$from_rid}='finish';   $hash{'type_'.$from_rid}='finish';
     }      }
   
     my $parser = HTML::TokeParser->new(\$instr);      $parser = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $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) {      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') {
Line 222  sub loadmap { Line 380  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);
                   if ($fileswitch) {
                       unless ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audomfile)) &&
                               (&Apache::lonnet::will_trust('coaurem',$audomfile,$env{'user.domain'}))) {
                           undef($editfile);
                       }
                   }
                   $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.',
                                          '<span class="LC_cusr_emph">','</span>');
                       } 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].",
                                              '<span class="LC_cusr_emph">'.$hash{'map_id_'.$parent_pc}.'</span>');
                           } 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].",
                                                  '<span class="LC_cusr_emph">'.$title.'</span>');
                               }
                               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.' &raquo; ';
                                   }
                               }
                               if ($title eq '') {
                                   $folderpath =~ s/\Q &raquo; \E$//;
                               } else {
                                   $folderpath .= $title;
                               }
                               if ($folderpath) {
                                   $errinfo .= '<br />'.&mt('Hierarchy is: [_1]',
                                                       '<span class="LC_cusr_emph">'.$folderpath.'</span>');
                               }
                           }
                       }
                   }
                   if ($uri =~ m{^/res/($match_domain)/($match_username)/.+\.(sequence|page)$}) {
                       ($audomfile,$aunamefile) = ($1,$2);
                       ($editfile,$filerole,$fileswitch) = &canedit_published($audomfile,$aunamefile);
                       if ($fileswitch) {
                           unless ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audomfile)) &&
                                   (&Apache::lonnet::will_trust('coaurem',$audomfile,$env{'user.domain'}))) {
                               undef($editfile);
                           }
                       }
                   }
               }
               if ($errinfo) {
                   $errinfo = '<br />'.$errinfo.'<br />';
               }
               if ($editfile) {
                   if ($errinfo ne '') {
                       $errinfo .= '<br />';
                   }
                   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');
                   }
                   if ($fileswitch) {
                       my $rolename = &Apache::lonnet::plaintext($filerole);
                       my $rolecode;
                       if ($filerole eq 'au') {
                           $rolecode = 'au./'.$audomfile.'/';
                       } else {
                           $rolecode = $filerole.'./'.$audomfile.'/'.$aunamefile;
                       }
                       $errinfo .= '.<br />'.&mt('You will need to [_1]switch server[_2].',
                                                '<a href="/adm/switchserver?otherserver='.$switchserver.'&amp;role='.$rolecode.'">','</a>');
                   } else {
                       my $fileurl = $uri;
                       $fileurl =~s{^/res/}{/priv/};
                       $errinfo .= ':&nbsp;<a href="javascript:go('."'$fileurl'".');">'.&mt('Create the missing file').'</a>';
                   }
               }
               if ($canedit) {
                   if ($errinfo ne '') {
                       $errinfo .= '<br />';
                   }
                   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');
                       }
                       if ($switchserver) {
                           $errinfo .= '.<br />';
                           if ((&Apache::lonnet::will_trust('othcoau',$env{'user.domain'},$audom)) &&
                               (&Apache::lonnet::will_trust('coaurem',$audom,$env{'user.domain'}))) {
                               $errinfo .= &mt('You will need to [_1]switch server[_2].',
                                               '<a href="/adm/switchserver?otherserver='.$switchserver.'&amp;role='.$rolecode.'">','</a>');
                           } else {
                               $errinfo .= &mt('Session switch required but prohibited.');
                           }
                       } else {
                           my $mapurl = $hash{'map_id_'.$parent_pc};
                           $mapurl =~s{^/res/}{/priv/};
                           $errinfo .= ':&nbsp;<a href="javascript:go('."'$mapurl'".');">'.&mt('Edit the map').'</a>';
                       }
                   } 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&amp;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 .= ':&nbsp;<a href="javascript:go('."'$dest'".');">'.$linktext.'</a>';
                   }
                   $errinfo .= '<br />';
               }
           }
       }
       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  # -------------------------------------------------------------------- Resource
   #
   #  Parses a resource tag to produce the value to push into the
   #  map_ids array.
   # 
   #
   #  Information about the actual type of resource is provided by the file extension
   #  of the uri (e.g. .problem, .sequence etc. etc.).
   #
   #  Parameters:
   #    $token   - A token from HTML::TokeParser
   #               This is an array that describes the most recently parsed HTML item.
   #    $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.
   #
   # Note:
   #   The token is an array that contains the following elements:
   #   [0]   => 'S' indicating this is a start token
   #   [1]   => 'resource'  indicating this tag is a <resource> tag.
   #   [2]   => Hash of attribute =>value pairs.
   #   [3]   => @(keys [2]).
   #   [4]   => unused.
   #
   #   The attributes of the resourcde tag include:
   #
   #   id     - The resource id.
   #   src    - The URI of the resource.
   #   type   - The resource type (e.g. start and finish).
   #   title  - The resource title.
   
   
 sub parse_resource {  sub parse_resource {
     my ($token,$lpc,$ispage,$uri) = @_;      my ($token,$lpc,$ispage,$uri,$courseid) = @_;
     if ($token->[2]->{'type'} eq 'zombie') { next; }      
     my $rid=$lpc.'.'.$token->[2]->{'id'};      # I refuse to countenance code like this that has 
       # such a dirty side effect (and forcing this sub to be called within a loop).
       #
       #  if ($token->[2]->{'type'} eq 'zombie') { next; }
       #
       #  The original code both returns _and_ skips to the next pass of the >caller's<
       #  loop, that's just dirty.
       #
   
       # Zombie resources don't produce anything useful.
   
       if ($token->[2]->{'type'} eq 'zombie') {
    return undef;
       }
   
       my $rid=$lpc.'.'.$token->[2]->{'id'}; # Resource id in hash is levelcounter.id-in-xml.
   
       # Save the hash element type and title:
           
     $hash{'kind_'.$rid}='res';      $hash{'kind_'.$rid}='res';
     $hash{'title_'.$rid}=$token->[2]->{'title'};      $hash{'title_'.$rid}=$token->[2]->{'title'};
   
       # Get the version free URI for the resource.
       # If a 'version' attribute was supplied, and this resource's version 
       # information has not yet been stored, store it.
       #
   
     my $turi=&versiontrack($token->[2]->{'src'});      my $turi=&versiontrack($token->[2]->{'src'});
     if ($token->[2]->{'version'}) {      if ($token->[2]->{'version'}) {
  unless ($hash{'version_'.$turi}) {   unless ($hash{'version_'.$turi}) {
     $hash{'version_'.$turi}=$1;      $hash{'version_'.$turi}=$1;
  }   }
     }      }
       # Pull out the title and do entity substitution on &colon
       # Q: Why no other entity substitutions?
   
     my $title=$token->[2]->{'title'};      my $title=$token->[2]->{'title'};
     $title=~s/\&colon\;/\:/gs;      $title=~s/\&colon\;/\:/gs;
 #   my $symb=&Apache::lonnet::encode_symb($uri,  
 #  $token->[2]->{'id'},  
 #  $turi);  
 #   &Apache::lonnet::do_cache_new('title',$symb,$title);      # I think the point of all this code is to construct a final
     unless ($ispage) {      # URI that apache and its rewrite rules can use to
       # fetch the resource.   Thi s sonly necessary if the resource
       # is not a page.  If the resource is a page then it must be
       # assembled (at fetch time?).
   
       if ($ispage) {
           if ($token->[2]->{'external'} eq 'true') { # external
               $turi=~s{^http\://}{/ext/};
           }
       } else {
  $turi=~/\.(\w+)$/;   $turi=~/\.(\w+)$/;
  my $embstyle=&Apache::loncommon::fileembstyle($1);   my $embstyle=&Apache::loncommon::fileembstyle($1);
  if ($token->[2]->{'external'} eq 'true') { # external   if ($token->[2]->{'external'} eq 'true') { # external
     $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;      $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//;
  } elsif ($turi=~/^\/*uploaded\//) { # uploaded   } elsif ($turi=~/^\/*uploaded\//) { # uploaded
     if (($embstyle eq 'img')       if (($embstyle eq 'img') 
  || ($embstyle eq 'emb')   || ($embstyle eq 'emb')
Line 258  sub parse_resource { Line 724  sub parse_resource {
     } elsif ($turi!~/\.(sequence|page)$/) {      } elsif ($turi!~/\.(sequence|page)$/) {
  $turi='/adm/coursedocs/showdoc'.$turi;   $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   } elsif ($turi=~/\S/) { # normal non-empty internal resource
     my $mapdir=$uri;      my $mapdir=$uri;
     $mapdir=~s/[^\/]+$//;      $mapdir=~s/[^\/]+$//;
Line 269  sub parse_resource { Line 737  sub parse_resource {
     }      }
  }   }
     }      }
 # Store reverse lookup, remove query string      # Store reverse lookup, remove query string resource 'ids'_uri => resource id.
       # If the URI appears more than one time in the sequence, it's resourcde
       # id's are constructed as a comma spearated list.
   
     my $idsuri=$turi;      my $idsuri=$turi;
     $idsuri=~s/\?.+$//;      $idsuri=~s/\?.+$//;
     if (defined($hash{'ids_'.$idsuri})) {      if (defined($hash{'ids_'.$idsuri})) {
Line 278  sub parse_resource { Line 749  sub parse_resource {
  $hash{'ids_'.$idsuri}=''.$rid;   $hash{'ids_'.$idsuri}=''.$rid;
     }      }
           
     if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {  
   
       if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) {
  $turi.='?register=1';   $turi.='?register=1';
     }      }
           
   
       # resource id lookup:  'src'_resourc-di  => URI decorated with a query
       # parameter as above if necessary due to the resource type.
       
     $hash{'src_'.$rid}=$turi;      $hash{'src_'.$rid}=$turi;
   
       # Mark the external-ness of the resource:
           
     if ($token->[2]->{'external'} eq 'true') {      if ($token->[2]->{'external'} eq 'true') {
  $hash{'ext_'.$rid}='true:';   $hash{'ext_'.$rid}='true:';
     } else {      } else {
  $hash{'ext_'.$rid}='false:';   $hash{'ext_'.$rid}='false:';
     }      }
   
       # If the resource is a start/finish resource set those
       # entries in the has so that navigation knows where everything starts.
       # TODO?  If there is a malformed sequence that has no start or no finish
       # resource, should this be detected and errors thrown?  How would such a 
       # resource come into being other than being manually constructed by a person
       # and then uploaded?  Could that happen if an author decided a sequence was almost
       # right edited it by hand and then reuploaded it to 'fix it' but accidently cut the
       #  start or finish resources?
       #
       #  All resourcess also get a type_id => (start | finish | normal)    hash entr.
       #
     if ($token->[2]->{'type'}) {      if ($token->[2]->{'type'}) {
  $hash{'type_'.$rid}=$token->[2]->{'type'};   $hash{'type_'.$rid}=$token->[2]->{'type'};
  if ($token->[2]->{'type'} eq 'start') {   if ($token->[2]->{'type'} eq 'start') {
Line 300  sub parse_resource { Line 791  sub parse_resource {
     }  else {      }  else {
  $hash{'type_'.$rid}='normal';   $hash{'type_'.$rid}='normal';
     }      }
   
       # Sequences end pages are constructed entities.  They require that the 
       # map that defines _them_ be loaded as well into the hash...with this resourcde
       # as the base of the nesting.
       # Resources like that are also marked with is_map_id => 1 entries.
       #
           
     if (($turi=~/\.sequence$/) ||      if (($turi=~/\.sequence$/) ||
  ($turi=~/\.page$/)) {   ($turi=~/\.page$/)) {
  $hash{'is_map_'.$rid}=1;   $hash{'is_map_'.$rid}=1;
  &loadmap($turi,$rid);   if ((!$hiddenurl{$rid}) || (&is_advanced($courseid))) {
       &loadmap($turi,$rid,$courseid);
    }
     }       } 
     return $token->[2]->{'id'};      return $token->[2]->{'id'};
 }  }
   
   #-------------------------------------------------------------------- link
   #  Links define how you are allowed to move from one resource to another.
   #  They are the transition edges in the directed graph that a map is.
   #  This sub takes informatino from a <link> tag and constructs the
   #  navigation bits and pieces of a map.  There is no requirement that the
   #  resources that are linke are already defined, however clearly the map is 
   #  badly broken if they are not _eventually_ defined.
   #
   #  Note that links can be unconditional or conditional.
   #
   #  Parameters:
   #     linkpc   - The link counter for this level of map nesting (this is 
   #                reset to zero by loadmap prior to starting to process
   #                links for map).
   #     lpc      - The map level ocounter (how deeply nested this map is in
   #                the hierarchy of maps that are recursively read in.
   #     to       - resource id (within the XML) of the target of the edge.
   #     from     - resource id (within the XML) of the source of the edge.
   #     condition- id of condition associated with the edge (also within the XML).
   #
   
 sub make_link {  sub make_link {
     my ($linkpc,$lpc,$to,$from,$condition) = @_;      my ($linkpc,$lpc,$to,$from,$condition) = @_;
           
       #  Compute fully qualified ids for the link, the 
       # and from/to by prepending lpc.
       #
   
     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 ($condition) {      if ($condition) {
  $undercond=$lpc.'.'.$condition;   $undercond=$lpc.'.'.$condition;
     }      }
   
       # Links are represnted by:
       #  goesto_.fuullyqualifedlinkid => fully qualified to
       #  comesfrom.fullyqualifiedlinkid => fully qualified from
       #  undercond_.fullyqualifiedlinkid => fully qualified condition id.
   
     $hash{'goesto_'.$linkid}=$goesto;      $hash{'goesto_'.$linkid}=$goesto;
     $hash{'comesfrom_'.$linkid}=$comesfrom;      $hash{'comesfrom_'.$linkid}=$comesfrom;
     $hash{'undercond_'.$linkid}=$undercond;      $hash{'undercond_'.$linkid}=$undercond;
   
       # In addition:
       #   to_.fully qualified from => comma separated list of 
       #   link ids with that from.
       # Similarly:
       #   from_.fully qualified to => comma separated list of link ids`
       #                               with that to.
       #  That allows us given a resource id to know all edges that go to it
       #  and leave from it.
       #
   
     if (defined($hash{'to_'.$comesfrom})) {      if (defined($hash{'to_'.$comesfrom})) {
  $hash{'to_'.$comesfrom}.=','.$linkid;   $hash{'to_'.$comesfrom}.=','.$linkid;
     } else {      } else {
Line 338  sub make_link { Line 880  sub make_link {
 }  }
   
 # ------------------------------------------------------------------- Condition  # ------------------------------------------------------------------- Condition
   #
   #  Processes <condition> tags, storing sufficient information about them
   #  in the hash so that they can be evaluated and used to conditionalize
   #  what is presented to the student.
   #
   #  these can have the following attributes 
   #
   #    id    = A unique identifier of the condition within the map.
   #
   #    value = Is a perl script-let that, when evaluated in safe space
   #            determines whether or not the condition is true.
   #            Normally this takes the form of a test on an  Apache::lonnet::EXT call
   #            to find the value of variable associated with a resource in the
   #            map identified by a mapalias.
   #            Here's a fragment of XML code that illustrates this:
   #
   #           <param to="5" value="mainproblem" name="parameter_0_mapalias" type="string" />
   #           <resource src="" id="1" type="start" title="Start" />
   #           <resource src="/res/msu/albertel/b_and_c/p1.problem" id="5"  title="p1.problem" />
   #           <condition value="&EXT('user.resource.resource.0.tries','mainproblem')
   #           <2 " id="61" type="stop" />
   #           <link to="5" index="1" from="1" condition="61" />    
   #
   #           In this fragment:
   #             - The param tag establishes an alias to resource id 5 of 'mainproblem'.
   #             - The resource that is the start of the map is identified.
   #             - The resource tag identifies the resource associated with this tag
   #               and gives it the id 5.
   #             - The condition is true if the tries variable associated with mainproblem
   #               is less than 2 (that is the user has had more than 2 tries).
   #               The condition type is a stop condition which inhibits(?) the associated
   #               link if the condition  is false. 
   #             - The link to resource 5 from resource 1 is affected by this condition.    
   #            
   #    type  = Type of the condition. The type determines how the condition affects the
   #            link associated with it and is one of
   #            -  'force'
   #            -  'stop'
   #              anything else including not supplied..which treated as:
   #            - 'normal'.
   #            Presumably maps get created by the resource assembly tool and therefore
   #            illegal type values won't squirm their way into the XML.
   #
   # Side effects:
   #   -  The kind_level-qualified-condition-id hash element is set to 'cond'.
   #   -  The condition text is pushed into the cond array and its element number is
   #      set in the condid_level-qualified-condition-id element of the hash.
   #   - The condition type is colon appneded to the cond array element for this condition.
 sub parse_condition {  sub parse_condition {
     my ($token,$lpc) = @_;      my ($token,$lpc) = @_;
     my $rid=$lpc.'.'.$token->[2]->{'id'};      my $rid=$lpc.'.'.$token->[2]->{'id'};
Line 356  sub parse_condition { Line 946  sub parse_condition {
 }  }
   
 # ------------------------------------------------------------------- Parameter  # ------------------------------------------------------------------- Parameter
   # Parse a <parameter> tag in the map.
   # Parmameters:
   #    $token Token array for a start tag from HTML::TokeParser
   #           [0] = 'S'
   #           [1] = tagname ("param")
   #           [2] = Hash of {attribute} = values.
   #           [3] = Array of the keys in [2].
   #           [4] = unused.
   #    $lpc   Current map nesting level.a
   #
   #  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 of parameter (e.g. parameter_randompick or parameter_randomorder).
   #     value=xxx - value of the parameter.
   
 sub parse_param {  sub parse_param {
     my ($token,$lpc) = @_;      my ($token,$lpc) = @_;
     my $referid=$lpc.'.'.$token->[2]->{'to'};      my $referid=$lpc.'.'.$token->[2]->{'to'}; # Resource param applies to.
     my $name=$token->[2]->{'name'};      my $name=$token->[2]->{'name'};      # Name of parameter
     my $part;      my $part;
     if ($name=~/^parameter_(.*)_/) {  
   
       if ($name=~/^parameter_(.*)_/) { 
  $part=$1;   $part=$1;
     } else {      } else {
  $part=0;   $part=0;
     }      }
   
       # Peel the parameter_ off the parameter name.
   
     $name=~s/^.*_([^_]*)$/$1/;      $name=~s/^.*_([^_]*)$/$1/;
   
       # The value is:
       #   type.part.name.value
   
     my $newparam=      my $newparam=
  &escape($token->[2]->{'type'}).':'.   &escape($token->[2]->{'type'}).':'.
  &escape($part.'.'.$name).'='.   &escape($part.'.'.$name).'='.
  &escape($token->[2]->{'value'});   &escape($token->[2]->{'value'});
   
       # The hash key is param_resourceid.
       # Multiple parameters for a single resource are & separated in the hash.
   
   
     if (defined($hash{'param_'.$referid})) {      if (defined($hash{'param_'.$referid})) {
  $hash{'param_'.$referid}.='&'.$newparam;   $hash{'param_'.$referid}.='&'.$newparam;
     } else {      } else {
  $hash{'param_'.$referid}=''.$newparam;   $hash{'param_'.$referid}=''.$newparam;
     }      }
     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {      #
       #  These parameters have to do with randomly selecting
       # resources, therefore a separate hash is also created to 
       # make it easy to locate them when actually computing the resource set later on
       # See the code conditionalized by ($randomize) in loadmap().
   
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { # Random selection turned on
  $randompick{$referid}=$token->[2]->{'value'};   $randompick{$referid}=$token->[2]->{'value'};
     }      }
     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {      if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { # Randomseed provided.
  $randompickseed{$referid}=$token->[2]->{'value'};   $randompickseed{$referid}=$token->[2]->{'value'};
     }      }
     if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) {      if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { # Random order turned on.
  $randomorder{$referid}=$token->[2]->{'value'};   $randomorder{$referid}=$token->[2]->{'value'};
     }      }
   
       # These parameters have to do with how the URLs of resources are presented to
       # course members(?).  encrypturl presents encypted url's while
       # hiddenresource hides the URL.
       #
   
     if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {      if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) {
  if ($token->[2]->{'value'}=~/^yes$/i) {   if ($token->[2]->{'value'}=~/^yes$/i) {
     $encurl{$referid}=1;      $encurl{$referid}=1;
Line 397  sub parse_param { Line 1028  sub parse_param {
  }   }
     }      }
 }  }
   #
   #  Parse mapalias parameters.
   #  these are tags of the form:
   #  <param to="nn" 
   #         value="some-alias-for-resourceid-nn" 
   #         name="parameter_0_mapalias" 
   #         type="string" />
   #  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 {  sub parse_mapalias_param {
     my ($token,$lpc) = @_;      my ($token,$lpc) = @_;
   
       # Fully qualify the to value and ignore the alias if there is no
       # corresponding resource.
   
     my $referid=$lpc.'.'.$token->[2]->{'to'};      my $referid=$lpc.'.'.$token->[2]->{'to'};
     return if (!exists($hash{'src_'.$referid}));      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.:
       #  <param to="1" value="george" name="parameter_0_mapalias" type="string" />
       #  <param to="2" value="george" name="parameter_0_mapalias" type="string" />
       #
       #  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$/) {      if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
  &count_mapalias($token->[2]->{'value'},$referid);   &count_mapalias($token->[2]->{'value'},$referid);
  $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;   $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
Line 411  sub parse_mapalias_param { Line 1080  sub parse_mapalias_param {
   
 # --------------------------------------------------------- Simplify expression  # --------------------------------------------------------- Simplify expression
   
   
   #
   #  Someone should really comment this to describe what it does to what and why.
   #
 sub simplify {  sub simplify {
     my $expression=shift;      my $expression=shift;
 # (0&1) = 1  # (0&1) = 1
Line 420  sub simplify { Line 1093  sub simplify {
 # 8&8=8  # 8&8=8
     $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g;      $expression=~s/([^_\.\d])([_\.\d]+)\&\2([^_\.\d])/$1$2$3/g;
 # 8|8=8  # 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  # (5&3)&4=5&3&4
     $expression=~s/\(([_\.\d]+)((?:\&[_\.\d]+)+)\)\&([_\.\d]+[^_\.\d])/$1$2\&$3/g;      $expression=~s/\(([_\.\d]+)((?:\&[_\.\d]+)+)\)\&([_\.\d]+[^_\.\d])/$1$2\&$3/g;
 # (((5&3)|(4&6)))=((5&3)|(4&6))  # (((5&3)|(4&6)))=((5&3)|(4&6))
Line 434  sub simplify { Line 1107  sub simplify {
   
 # -------------------------------------------------------- Build condition hash  # -------------------------------------------------------- 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 {  sub traceroute {
     my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag,$cid)=@_;
     my $newsofar=$sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
   
     unless ($beenhere=~/\&\Q$rid\E\&/) {      unless ($beenhere=~/\&\Q$rid\E\&/) {
  $beenhere.=$rid.'&';     $beenhere.=$rid.'&';  
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
Line 452  sub traceroute { Line 1154  sub traceroute {
   
  my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);   my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
  if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }   if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
   
  if (($retfrid eq '') && ($hash{'src_'.$rid})   if (($retfrid eq '') && ($hash{'src_'.$rid})
     && ($hash{'src_'.$rid}!~/\.sequence$/)) {      && ($hash{'src_'.$rid}!~/\.sequence$/)) {
     $retfrid=$rid;      $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})) {   if (defined($hash{'conditions_'.$rid})) {
     $hash{'conditions_'.$rid}=simplify(      $hash{'conditions_'.$rid}=simplify(
            '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');             '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
Line 465  sub traceroute { Line 1193  sub traceroute {
   
  # if the expression is just the 0th condition keep it   # if the expression is just the 0th condition keep it
  # otherwise leave a pointer to this condition expression   # otherwise leave a pointer to this condition expression
   
  $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;   $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;
   
    # Recurse if the resource is a map:
   
  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}})) {
  $sofar=$newsofar=   $sofar=$newsofar=
     &traceroute($sofar,      &traceroute($sofar,
  $hash{'map_start_'.$hash{'src_'.$rid}},'&',   $hash{'map_start_'.$hash{'src_'.$rid}},
    $beenhere,
  $encflag || $encurl{$rid},   $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})) {   if (defined($hash{'to_'.$rid})) {
     foreach my $id (split(/\,/,$hash{'to_'.$rid})) {      foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
  my $further=$sofar;   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 ($hash{'undercond_'.$id}) {
     if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {      if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {
  $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});   $errtext.= '<br />'.
                                      &mt('Undefined condition ID: [_1]',
                                          $hash{'undercond_'.$id});
     }      }
                 }                  }
    #  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,$cid);
     }      }
  }   }
     }      }
Line 497  sub traceroute { Line 1242  sub traceroute {
   
 # ------------------------------ Cascading conditions, quick access, parameters  # ------------------------------ Cascading conditions, quick access, parameters
   
   #
   #  Seems a rather strangely named sub given what the comment above says it does.
   
   
 sub accinit {  sub accinit {
     my ($uri,$short,$fn)=@_;      my ($uri,$short,$fn)=@_;
     my %acchash=();      my %acchash=();
     my %captured=();      my %captured=();
     my $condcounter=0;      my $condcounter=0;
     $acchash{'acc.cond.'.$short.'.0'}=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)) {      foreach my $key (keys(%hash)) {
   
    # conditions:
   
  if ($key=~/^conditions/) {   if ($key=~/^conditions/) {
     my $expr=$hash{$key};      my $expr=$hash{$key};
   
     # try to find and factor out common sub-expressions      # 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) {      foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) {
  my $orig=$sub;   my $orig=$sub;
   
Line 520  sub accinit { Line 1282  sub accinit {
  $expr=~s/\Q$orig\E/$sub/;   $expr=~s/\Q$orig\E/$sub/;
     }      }
     $hash{$key}=$expr;      $hash{$key}=$expr;
   
              # If not yet seen, record in acchash and that we've seen it.
   
     unless (defined($captured{$expr})) {      unless (defined($captured{$expr})) {
  $condcounter++;   $condcounter++;
  $captured{$expr}=$condcounter;   $captured{$expr}=$condcounter;
  $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;   $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
     }       } 
           # Parameters:
   
  } elsif ($key=~/^param_(\d+)\.(\d+)/) {   } elsif ($key=~/^param_(\d+)\.(\d+)/) {
     my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,      my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,
     $hash{'src_'.$1.'.'.$2});      $hash{'src_'.$1.'.'.$2});
Line 538  sub accinit { Line 1305  sub accinit {
     }      }
  }   }
     }      }
       # This loop only processes id entries in the big hash.
   
     foreach my $key (keys(%hash)) {      foreach my $key (keys(%hash)) {
  if ($key=~/^ids/) {   if ($key=~/^ids/) {
     foreach my $resid (split(/\,/,$hash{$key})) {      foreach my $resid (split(/\,/,$hash{$key})) {
Line 572  sub accinit { Line 1341  sub accinit {
     $acchash{'acc.res.'.$short.'.'}='&:0&';      $acchash{'acc.res.'.$short.'.'}='&:0&';
     my $courseuri=$uri;      my $courseuri=$uri;
     $courseuri=~s/^\/res\///;      $courseuri=~s/^\/res\///;
     &Apache::lonnet::delenv('(acc\.|httpref\.)');      my $regexp = 1;
     &Apache::lonnet::appenv(%acchash);      &Apache::lonnet::delenv('(acc\.|httpref\.)',$regexp);
       &Apache::lonnet::appenv(\%acchash);
 }  }
   
 # ---------------- Selectively delete from randompick maps and hidden url parms  # ---------------- Selectively delete from randompick maps and hidden url parms
   
 sub hiddenurls {  sub hiddenurls {
     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 601  sub hiddenurls { Line 1371  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 $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   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);   &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]]=''; }
Line 611  sub hiddenurls { Line 1392  sub hiddenurls {
             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]);
                   if ($rescount{$mapid}) {
                       $rescount{$mapid} --;
                   }
                   if ($hash{'is_map_'.$currentrids[$k]}) {
                       if ($mapcount{$mapid}) {
                           $mapcount{$mapid} --;
                       }
                   }
                 $randomoutentry.='&'.                  $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
  $resid,   $resid,
Line 620  sub hiddenurls { Line 1409  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);
           if ($rescount{$mapid}) {
               $rescount{$mapid} --;
           }
           if ($hash{'is_map_'.$rid}) {
               if ($mapcount{$mapid}) {
                   $mapcount{$mapid} --;
               }
           }
  $randomoutentry.='&'.   $randomoutentry.='&'.
     &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
  $hash{'src_'.$rid}).'&';   $hash{'src_'.$rid}).'&';
     }      }
 # --------------------------------------- append randomout entry to environment  # --------------------------------------- append randomout entry to environment
     if ($randomoutentry) {      if ($randomoutentry) {
  &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);   &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry});
       }
   }
   
   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  # ---------------------------------------------------- Read map and all submaps
   
 sub readmap {  sub readmap {
     my $short=shift;      my ($short,$critmsg_check) = @_;
     $short=~s/^\///;      $short=~s/^\///;
     my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1});  
       # TODO:  Hidden dependency on current user:
   
       my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); 
   
     my $fn=$cenv{'fn'};      my $fn=$cenv{'fn'};
     my $uri;      my $uri;
     $short=~s/\//\_/g;      $short=~s/\//\_/g;
     unless ($uri=$cenv{'url'}) {       unless ($uri=$cenv{'url'}) { 
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis('<font color="blue">WARNING: '.
  "Could not load course $short.</font>");    "Could not load course $short.</font>"); 
  return ('',&mt('No course data available.'));;   return ('',&mt('No course data available.'));;
     }      }
     @cond=('true:normal');      @cond=('true:normal');
   
     open(LOCKFILE,">$fn.db.lock");      unless (open(LOCKFILE,">","$fn.db.lock")) {
    # 
    # Most likely a permissions problem on the lockfile or its directory.
    #
           $retfurl = '';
           return ($retfurl,'<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.');
       }
     my $lock=0;      my $lock=0;
     if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {      my $gotstate=0;
  $lock=1;      
  unlink($fn.'.db');      # If we can get the lock without delay any files there are idle
  unlink($fn.'_symb.db');      # and from some prior request.  We'll kill them off and regenerate them:
  unlink($fn.'.state');  
  unlink($fn.'parms.db');      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
    $lock=1; # Remember that we hold the lock.
           &unlink_tmpfiles($fn);
     }      }
     undef %randompick;      undef %randompick;
       undef %randompickseed;
       undef %randomorder;
       undef %randomizationcode;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
       undef %deeplinkout;
       undef %rescount;
       undef %mapcount;
     $retfrid='';      $retfrid='';
     if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&      $errtext='';
  (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {      my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.
  %hash=();  
  %parmhash=();      # if we got the lock, regenerate course regnerate empty files and tie them.
  $errtext='';  
  $pc=0;      if ($lock) {
  &clear_mapalias_count();          if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
  &processversionfile(%cenv);              $tiedhash = 1;
  my $furi=&Apache::lonnet::clutter($uri);              if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
  $hash{'src_0.0'}=&versiontrack($furi);                  $tiedparmhash = 1;
  $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');                  $gotstate = &build_tmp_hashes($uri,
  $hash{'ids_'.$furi}='0.0';        $fn,
  $hash{'is_map_0.0'}=1;        $short,
  loadmap($uri,'0.0');        \%cenv); # TODO: Need to provide requested user@dom
  if (defined($hash{'map_start_'.$uri})) {                  unless ($gotstate) {
     &Apache::lonnet::appenv("request.course.id"  => $short,                      &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');
     "request.course.fn"  => $fn,                  }
     "request.course.uri" => $uri);                  $untiedparmhash = untie(%parmhash);
     $env{'request.course.id'}=$short;                  unless ($untiedparmhash) {
     &traceroute('0',$hash{'map_start_'.$uri},'&');                      &Apache::lonnet::logthis('<font color="blue">WARNING: '.
     &accinit($uri,$short,$fn);                          'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.</font>');
     &hiddenurls();                  }
  }              }
  $errtext .= &get_mapalias_errors();              $untiedhash = untie(%hash);
 # ------------------------------------------------------- Put versions into src              unless ($untiedhash) {
  foreach my $key (keys(%hash)) {                  &Apache::lonnet::logthis('<font color="blue">WARNING: '.
     if ($key=~/^src_/) {                      'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
  $hash{$key}=&putinversion($hash{$key});              }
     } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {          }
  my ($type, $url) = ($1,$2);   flock(LOCKFILE,LOCK_UN); # RF: this is what I don't get unless there are other
  my $value = $hash{$key};                           # unlocked places the remainder happens..seems like if we
  $hash{$type.&putinversion($url)}=$value;                                   # just kept the lock here the rest of the code would have
     }                                   # been much easier? 
  }      }
 # ---------------------------------------------------------------- Encrypt URLs      unless ($lock && $tiedhash && $tiedparmhash) { 
  foreach my $id (keys(%encurl)) {  
 #    $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id});  
     $hash{'encrypted_'.$id}=1;  
  }  
 # ----------------------------------------------- Close hashes to finally store  
 # --------------------------------- Routine must pass this point, no early outs  
  $hash{'first_rid'}=$retfrid;  
  my ($mapid,$resid)=split(/\./,$retfrid);  
  $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};  
  my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});  
  $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });  
  if ($hash{'encrypted_'.$retfrid}) {  
     $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));  
  }  
  $hash{'first_url'}=$retfurl;  
  unless ((untie(%hash)) && (untie(%parmhash))) {  
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
      "Could not untie coursemap $fn for $uri.</font>");   
  }  
 # ---------------------------------------------------- Store away initial state  
  {  
     my $cfh;  
     if (open($cfh,">$fn.state")) {  
  print $cfh join("\n",@cond);  
     } else {  
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
  "Could not write statemap $fn for $uri.</font>");   
     }  
  }  
  flock(LOCKFILE,LOCK_UN);  
  close(LOCKFILE);  
     } else {  
  # if we are here it is likely because we are already trying to    # if we are here it is likely because we are already trying to 
  # initialize the course in another child, busy wait trying to    # initialize the course in another child, busy wait trying to 
  # tie the hashes for the next 90 seconds, if we succeed forward    # tie the hashes for the next 90 seconds, if we succeed forward 
  # them on to navmaps, if we fail, throw up the Could not init    # them on to navmaps, if we fail, throw up the Could not init 
  # course screen   # course screen
    #
    # RF: I'm not seeing the case where the ties/unties can fail in a way
    #     that can be remedied by this.  Since we owned the lock seems
    #     Tie/untie failures are a result of something like a permissions problem instead?
    #
   
    #  In any vent, undo what we did manage to do above first:
  if ($lock) {   if ($lock) {
     # Got the lock but not the DB files      # Got the lock but not the DB files
     flock(LOCKFILE,LOCK_UN);      flock(LOCKFILE,LOCK_UN);
               $lock = 0;
  }   }
  untie(%hash);          if ($tiedhash) {
  untie(%parmhash);              unless($untiedhash) {
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".          untie(%hash);
  "Could not tie coursemap $fn for $uri.</font>");               }
           }
           if ($tiedparmhash) {
               unless($untiedparmhash) {
                   untie(%parmhash);
               }
           }
    # Log our failure:
   
    &Apache::lonnet::logthis('<font color="blue">WARNING: '.
    "Could not tie coursemap $fn for $uri.</font>");
           $tiedhash = '';
           $tiedparmhash = '';
  my $i=0;   my $i=0;
   
    # Keep on retrying the lock for 90 sec until we succeed.
   
  while($i<90) {   while($i<90) {
     $i++;      $i++;
     sleep(1);      sleep(1);
     if (flock(LOCKFILE,LOCK_EX|LOCK_NB) &&      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
  (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {  
  if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {   # Got the lock, tie the hashes...the assumption in this code is
     $retfurl='/adm/navmaps';   # that some other worker thread has created the db files quite recently
     &Apache::lonnet::appenv("request.course.id"  => $short,   # so no load is needed:
     "request.course.fn"  => $fn,  
     "request.course.uri" => $uri);                  $lock = 1;
     untie(%hash);   if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
     untie(%parmhash);                      $tiedhash = 1;
     last;      if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
  }                          $tiedparmhash = 1;
     }                          if (-e "$fn.state") {
     untie(%hash);              $retfurl='/adm/navmaps';
     untie(%parmhash);  
       # BUG BUG: Side effect!
       # Should conditionalize on something so that we can use this
       # to load maps for courses that are not current?
       #
               &Apache::lonnet::appenv({"request.course.id"  => $short,
                  "request.course.fn"  => $fn,
                "request.course.uri" => $uri,
                                                        "request.course.tied" => time});
                               
               $untiedhash = untie(%hash);
               $untiedparmhash = untie(%parmhash);
                               $gotstate = 1;
               last;
           }
                           $untiedparmhash = untie(%parmhash);
               }
               $untiedhash = untie(%hash);
                   }
               }
  }   }
  flock(LOCKFILE,LOCK_UN);          if ($lock) {
  close(LOCKFILE);              flock(LOCKFILE,LOCK_UN);
               $lock = 0;
               if ($tiedparmhash) {
                   unless ($untiedparmhash) {
                       &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                           'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.</font>');
                   }
               }
               if ($tiedparmhash) {
                   unless ($untiedhash) {
                       &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                           'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
                   }
               }
           }
       }
       # I think this branch of code is all about what happens if we just did the stuff above, 
       # but found that the  state file did not exist...again if we'd just held the lock
       # would that have made this logic simpler..as generating all the files would be
       # an atomic operation with respect to the lock.
       #
       unless ($gotstate) {
           $lock = 0;
           &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                        'Could not read statemap '.$fn.' for '.$uri.'.</font>');
           &unlink_tmpfiles($fn);
           if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
               $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.
    #
           if ($lock) {
               if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
                   if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
                       $gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv); # TODO: User dependent?
                       unless ($gotstate) {
                           &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                               'Failed to write statemap at second attempt '.$fn.' for '.$uri.'.</font>');
                       }
                       unless (untie(%parmhash)) {
                           &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                               'Could not untie coursemap parmhash '.$fn.'.db for '.$uri.'.</font>');
                       }
                   } else {
                       &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                           'Could not tie coursemap '.$fn.'__parms.db for '.$uri.'.</font>');
                   }
                   unless (untie(%hash)) {
                       &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                           'Could not untie coursemap hash '.$fn.'.db for '.$uri.'.</font>');
                   }
               } else {
                  &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                      'Could not tie coursemap '.$fn.'.db for '.$uri.'.</font>');
               }
               flock(LOCKFILE,LOCK_UN);
               $lock = 0;
           } else {
       # Failed to get the immediate lock.
   
               &Apache::lonnet::logthis('<font color="blue">WARNING: '.
               'Could not obtain lock to tie coursemap hash '.$fn.'.db for '.$uri.'.</font>');
           }
       }
       close(LOCKFILE);
       unless (($errtext eq '') || ($env{'request.course.uri'} =~ m{^/uploaded/})) {
           &Apache::lonmsg::author_res_msg($env{'request.course.uri'},
                                           $errtext); # TODO: User dependent?
     }      }
     &Apache::lonmsg::author_res_msg($env{'request.course.uri'},$errtext);  
 # ------------------------------------------------- Check for critical messages  # ------------------------------------------------- Check for critical messages
   
     my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},  #  Depends on user must parameterize this as well..or separate as this is:
    $env{'user.name'});  #  more part of determining what someone sees on entering a course?
     if ($what[0]) {  #  When lonuserstate::readmap() is called from lonroles.pm, i.e.,
  if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {  #  after selecting a role in a course, critical_redirect will be called,
     $retfurl='/adm/email?critical=display';  #  unless the course has a blocking event in effect, which suppresses
   #  critical message checking (users without evb priv).
   #
   
       if ($critmsg_check) {
           my ($redirect,$url) = &Apache::loncommon::critical_redirect();
           if ($redirect) {
               $retfurl = $url;
         }          }
     }      }
     return ($retfurl,$errtext);      return ($retfurl,$errtext);
 }  }
   
   #
   #  This sub is called when the course hash and the param hash have been tied and
   #  their lock file is held.
   #  Parameters:
   #     $uri      -  URI that identifies the course.
   #     $fn       -  The base path/filename of the files that make up the context
   #                  being built.
   #     $short    -  Short course name.
   #     $cenvref  -  Reference to the course environment hash returned by 
   #                  Apache::lonnet::coursedescription
   #
   #  Assumptions:
   #    The globals
   #    %hash, %paramhash are tied to their gdbm files and we hold the lock on them.
   #
   sub build_tmp_hashes {
       my ($uri,$fn,$short,$cenvref) = @_;
       
       unless(ref($cenvref) eq 'HASH') {
           return;
       }
       my %cenv = %{$cenvref};
       my $gotstate = 0;
       %hash=(); # empty the global course and  parameter hashes.
       %parmhash=();
       $errtext=''; # No error messages yet.
       $pc=0;
       &clear_mapalias_count();
       &processversionfile(%cenv);
   
       # URI Of the map file.
   
       my $furi=&Apache::lonnet::clutter($uri);
       #
       #  the map staring points.
       #
       $hash{'src_0.0'}=&versiontrack($furi);
       $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
       $hash{'ids_'.$furi}='0.0';
       $hash{'is_map_0.0'}=1;
   
       # 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.tied" => time});
           $env{'request.course.id'}=$short;
           &traceroute('0',$hash{'map_start_'.$uri},'&','','',$short);
           &accinit($uri,$short,$fn);
           &hiddenurls();
       }
       $errtext .= &get_mapalias_errors();
   # ------------------------------------------------------- Put versions into src
       foreach my $key (keys(%hash)) {
           if ($key=~/^src_/) {
               $hash{$key}=&putinversion($hash{$key});
           } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {
               my ($type, $url) = ($1,$2);
               my $value = $hash{$key};
               $hash{$type.&putinversion($url)}=$value;
           }
       }
   # ---------------------------------------------------------------- Encrypt URLs
       foreach my $id (keys(%encurl)) {
   #           $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id});
           $hash{'encrypted_'.$id}=1;
       }
   # ----------------------------------------------- Close hashes to finally store
   # --------------------------------- Routine must pass this point, no early outs
       $hash{'first_rid'}=$retfrid;
       my ($mapid,$resid)=split(/\./,$retfrid);
       $hash{'first_mapurl'}=$hash{'map_id_'.$mapid};
       my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid});
       $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb });
       if ($hash{'encrypted_'.$retfrid}) {
           $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F'));
       }
       $hash{'first_url'}=$retfurl;
   # ---------------------------------------------------- Store away initial state
       {
           my $cfh;
           if (open($cfh,">","$fn.state")) {
               print $cfh join("\n",@cond);
               $gotstate = 1;
           } else {
               &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                                        "Could not write statemap $fn for $uri.</font>");
           }
       }
   
       # 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;
   }
   
   sub unlink_tmpfiles {
       my ($fn) = @_;
       my $file_dir = dirname($fn);
   
       if ("$file_dir/" eq LONCAPA::tempdir()) {
           my @files = qw (.db _symb.db .state _parms.db);
           foreach my $file (@files) {
               if (-e $fn.$file) {
                   unless (unlink($fn.$file)) {
                       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                                    "Could not unlink ".$fn.$file."</font>");
                   }
               }
           }
       }
       return;
   }
   
 # ------------------------------------------------------- Evaluate state string  # ------------------------------------------------------- Evaluate state string
   
 sub evalstate {  sub evalstate {
Line 785  sub evalstate { Line 1943  sub evalstate {
     if (-e $fn) {      if (-e $fn) {
  my @conditions=();   my @conditions=();
  {   {
     open(my $fh,"<$fn");      open(my $fh,"<",$fn);
     @conditions=<$fh>;      @conditions=<$fh>;
             close($fh);              close($fh);
  }     }  
Line 813  sub evalstate { Line 1971  sub evalstate {
     }      }
  }   }
     }      }
     &Apache::lonnet::appenv('user.state.'.$env{'request.course.id'} => $state);      &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state});
     return $state;      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;
                   }
               }
               my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what;
               if (defined($$useropt{$recursechk})) {
                   return $$useropt{$recursechk};
               }
           }
       }
   
       # 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;
                   }
               }
               my $recursechk=$usercourseprefix.'.['.$cgroup.'].'.$item.'___(rec).'.$what;
               if (defined($$courseopt{$recursechk})) {
                   return $$courseopt{$recursechk};
               }
           }
       }
   
       # 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;
                   }
               }
               my $recursechk=$usercourseprefix.'.['.$csec.'].'.$item.'___(rec).'.$what;
               if (defined($$courseopt{$recursechk})) {
                   return $$courseopt{$recursechk};
               }
           }
       }
   
       # 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;
                       }
                   }
                   my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what;
                   if (defined($$courseopt{$recursechk})) {
                       return $$courseopt{$recursechk};
                   }
               }
           }
       }
       return undef;
   }
   
   #  This block seems to have code to manage/detect doubly defined
   #  aliases in maps.
   
 {  {
     my %mapalias_cache;      my %mapalias_cache;
     sub count_mapalias {      sub count_mapalias {
Line 837  sub evalstate { Line 2173  sub evalstate {
      $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},'<br />',
      $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});       $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
      } (@{ $mapalias_cache{$mapalias} }));       } (@{ $mapalias_cache{$mapalias} }));
     next if ($count < 2);      next if ($count < 2);
Line 876  of course for user. Line 2212  of course for user.
 This is part of the LearningOnline Network with CAPA project  This is part of the LearningOnline Network with CAPA project
 described at http://www.lon-capa.org.  described at http://www.lon-capa.org.
   
 =head1 HANDLER SUBROUTINE  =head1 SUBROUTINES
   
 There is no handler subroutine.  
   
 =head1 OTHER SUBROUTINES  
   
 =over 4  =over
   
 =item *  =item loadmap()
   
 loadmap() : Loads map from disk  Loads map from disk
   
 =item *  =item simplify()
   
 simplify() : Simplify expression  Simplify expression
   
 =item *  =item traceroute()
   
 traceroute() : Build condition hash  Build condition hash
   
 =item *  =item accinit()
   
 accinit() : Cascading conditions, quick access, parameters  Cascading conditions, quick access, parameters
   
 =item *  =item readmap()
   
 readmap() : Read map and all submaps  Read map and all submaps
   
 =item *  =item evalstate()
   
 evalstate() : Evaluate state string  Evaluate state string
   
 =back  =back
   

Removed from v.1.125  
changed lines
  Added in v.1.169


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