Diff for /rat/lonuserstate.pm between versions 1.69 and 1.138

version 1.69, 2003/12/15 15:26:26 version 1.138, 2011/07/26 10:40:23
Line 31  package Apache::lonuserstate; Line 31  package Apache::lonuserstate;
   
 # ------------------------------------------------- modules used by this module  # ------------------------------------------------- modules used by this module
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  
 use Apache::File;  
 use HTML::TokeParser;  use HTML::TokeParser;
 use Apache::lonnet();  use Apache::lonnet;
   use Apache::lonlocal;
 use Apache::loncommon();  use Apache::loncommon();
 use GDBM_File;  use GDBM_File;
 use Apache::lonmsg;  use Apache::lonmsg;
 use Safe;  use Safe;
 use Safe::Hole;  use Safe::Hole;
 use Opcode;  use Opcode;
   use Apache::lonenc;
   use Fcntl qw(:flock);
   use LONCAPA;
   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
 my $errtext; # variable with all errors  my $errtext; # variable with all errors
 my $retfurl; # variable with the very first URL in the course  my $retfrid; # variable with the very first RID in the course
   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 %encurl; # URLs in this folder are supposed to be encrypted
   my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
   
 # ----------------------------------- 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 />';
   }
   
 sub versiontrack {  sub versiontrack {
     my $uri=shift;      my $uri=shift;
     if ($uri=~/\.(\d+)\.\w+$/) {      if ($uri=~/\.(\d+)\.\w+$/) {
Line 62  sub versiontrack { Line 77  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 71  sub versiontrack { Line 88  sub versiontrack {
   
 sub putinversion {  sub putinversion {
     my $uri=shift;      my $uri=shift;
       my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri);
     if ($hash{'version_'.$uri}) {      if ($hash{'version_'.$uri}) {
  my $version=$hash{'version_'.$uri};   my $version=$hash{'version_'.$uri};
  if ($version eq 'mostrecent') { return $uri; }   if ($version eq 'mostrecent') { return $uri; }
Line 79  sub putinversion { Line 97  sub putinversion {
              { return $uri; }               { return $uri; }
  $uri=~s/\.(\w+)$/\.$version\.$1/;   $uri=~s/\.(\w+)$/\.$version\.$1/;
     }      }
       &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
     return $uri;      return $uri;
 }  }
   
Line 89  sub processversionfile { Line 108  sub processversionfile {
     my %versions=&Apache::lonnet::dump('resourceversions',      my %versions=&Apache::lonnet::dump('resourceversions',
        $cenv{'domain'},         $cenv{'domain'},
        $cenv{'num'});         $cenv{'num'});
     foreach (keys %versions) {      foreach my $ver (keys(%versions)) {
  if ($_=~/^error\:/) { return; }   if ($ver=~/^error\:/) { return; }
  $hash{'version_'.$_}=$versions{$_};   $hash{'version_'.$ver}=$versions{$ver};
     }      }
 }  }
   
 # --------------------------------------------------------- Loads map from disk  # --------------------------------------------------------- Loads from disk
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my ($uri,$parent_rid)=@_;
     if ($hash{'map_pc_'.$uri}) { return OK; }  
       # Is the map already included?
   
       if ($hash{'map_pc_'.$uri}) { 
    $errtext.='<p class="LC_error">'.
       &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
       '</p>';
    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.="Invalid map: $fn\n";      unless (($fn=~/\.sequence$/) || $ispage) { 
        return OK;    $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);
    return; 
     }      }
   
       # Read the XML that constitutes the file.
   
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
   
     unless ($instr eq -1) {      if ($instr eq -1) {
           $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);
    return;
       }
   
       # 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);
       $parser->attr_encoded(1);
   
       # first get all parameters
   
   
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
    if ($token->[1] eq 'param') {
       &parse_param($token,$lpc);
    } 
       }
   
       # Get set to take another pass through the XML:
       # for resources and links.
   
 # Successfully got file, parse it      $parser = HTML::TokeParser->new(\$instr);
       $parser->attr_encoded(1);
   
         my $parser = HTML::TokeParser->new(\$instr);      my $linkpc=0;
         my $token;  
   
         my $linkpc=0;      $fn=~/\.(\w+)$/;
   
         $fn=~/\.(\w+)$/;      $hash{'map_type_'.$lpc}=$1;
   
       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;
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
   
    # Resource
   
    if ($token->[1] eq 'resource') {
       my $resource_id = &parse_resource($token,$lpc,$ispage,$uri);
       if (defined $resource_id) {
    push(@map_ids, $resource_id);
       }
   
          # Link
   
    } elsif ($token->[1] eq 'link' && !$randomize) {
       &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
          $token->[2]->{'from'},
          $token->[2]->{'condition'});
   
    # condition
   
    } elsif ($token->[1] eq 'condition' && !$randomize) {
       &parse_condition($token,$lpc);
    }
       }
   
   
       # Handle randomization and random selection
   
       if ($randomize) {
    if (!$env{'request.role.adv'}) {
       my $seed;
       if (defined($randompickseed{$parent_rid})) {
    $seed = $randompickseed{$parent_rid};
       } else {
    my ($mapid,$resid)=split(/\./,$parent_rid);
    my $symb=
       &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
    $resid,$hash{'src_'.$parent_rid});
   
    $seed = $symb;
       }
   
       # Here for sure we need to pass along the username/domain
       # so that we can impersonate users in lonprintout e.g.
   
       my $rndseed=&Apache::lonnet::rndseed($seed);
       &Apache::lonnet::setup_random_from_rndseed($rndseed);
       @map_ids=&Math::Random::random_permutation(@map_ids);
    }
    my $from = shift(@map_ids);
    my $from_rid = $lpc.'.'.$from;
    $hash{'map_start_'.$uri} = $from_rid;
    $hash{'type_'.$from_rid}='start';
   
    while (my $to = shift(@map_ids)) {
       &make_link(++$linkpc,$lpc,$to,$from);
       my $to_rid =  $lpc.'.'.$to;
       $hash{'type_'.$to_rid}='normal';
       $from = $to;
       $from_rid = $to_rid;
    }
   
    $hash{'map_finish_'.$uri}= $from_rid;
    $hash{'type_'.$from_rid}='finish';
       }
   
       $parser = HTML::TokeParser->new(\$instr);
       $parser->attr_encoded(1);
       # last parse out the mapalias params so as to ignore anything
       # refering to non-existant resources
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
    if ($token->[1] eq 'param') {
       &parse_mapalias_param($token,$lpc);
    } 
       }
   }
   
         $hash{'map_type_'.$lpc}=$1;  
   
         while ($token = $parser->get_token) {  
     if ($token->[0] eq 'S') {  
                 if ($token->[1] eq 'resource') {  
 # -------------------------------------------------------------------- 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.
   # Returns:
   #
   # 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 {
       my ($token,$lpc,$ispage,$uri) = @_;
       
       # I refuse to coutenance 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; }
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};      # Zombie resources don't produce anything useful.
   
                     $hash{'kind_'.$rid}='res';      if ($token->[2]->{'type'} eq 'zombie') {
                     $hash{'title_'.$rid}=$token->[2]->{'title'};   return undef;
                     my $turi=&versiontrack($token->[2]->{'src'});      }
                     if ($token->[2]->{'version'}) {  
  unless ($hash{'version_'.$turi}) {  
     $hash{'version_'.$turi}=$1;  
  }  
     }  
     &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache,  
        &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'},  
     $turi),  
       $token->[2]->{'title'},'title');  
                     unless ($ispage) {  
                         $turi=~/\.(\w+)$/;  
                         my $embstyle=&Apache::loncommon::fileembstyle($1);  
                         if ($token->[2]->{'external'} eq 'true') { # external  
                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;  
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded  
     if (($embstyle eq 'img') || ($embstyle eq 'emb')  
                              || ($embstyle eq 'ssi')) {  
                                 $turi='/adm/wrapper'.$turi;  
                             } elsif ($turi!~/\.(sequence|page)$/) {  
  $turi='/adm/coursedocs/showdoc'.$turi;  
                             }  
                         } elsif ($turi) { # normal non-empty internal resource  
     my $mapdir=$uri;  
     $mapdir=~s/[^\/]+$//;  
     $turi=&Apache::lonnet::hreflocation($mapdir,$turi);  
     if (($embstyle eq 'img') || ($embstyle eq 'emb')) {  
  $turi='/adm/wrapper'.$turi;  
     }  
                         }  
     }  
   
                     if (defined($hash{'ids_'.$turi})) {      my $rid=$lpc.'.'.$token->[2]->{'id'};
                         $hash{'ids_'.$turi}.=','.$rid;      
                     } else {      $hash{'kind_'.$rid}='res';
                         $hash{'ids_'.$turi}=''.$rid;      $hash{'title_'.$rid}=$token->[2]->{'title'};
                     }      my $turi=&versiontrack($token->[2]->{'src'});
                      if ($token->[2]->{'version'}) {
                     if   unless ($hash{'version_'.$turi}) {
         ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {      $hash{'version_'.$turi}=$1;
  $turi.='?register=1';   }
     }      }
       my $title=$token->[2]->{'title'};
       $title=~s/\&colon\;/\:/gs;
   #   my $symb=&Apache::lonnet::encode_symb($uri,
   #  $token->[2]->{'id'},
   #  $turi);
   #   &Apache::lonnet::do_cache_new('title',$symb,$title);
       unless ($ispage) {
    $turi=~/\.(\w+)$/;
    my $embstyle=&Apache::loncommon::fileembstyle($1);
    if ($token->[2]->{'external'} eq 'true') { # external
       $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//;
    } elsif ($turi=~/^\/*uploaded\//) { # uploaded
       if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
    $turi='/adm/wrapper'.$turi;
       } elsif ($embstyle eq 'ssi') {
    #do nothing with these
       } elsif ($turi!~/\.(sequence|page)$/) {
    $turi='/adm/coursedocs/showdoc'.$turi;
       }
    } elsif ($turi=~/\S/) { # normal non-empty internal resource
       my $mapdir=$uri;
       $mapdir=~s/[^\/]+$//;
       $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
       if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
    $turi='/adm/wrapper'.$turi;
       }
    }
       }
   # Store reverse lookup, remove query string
       my $idsuri=$turi;
       $idsuri=~s/\?.+$//;
       if (defined($hash{'ids_'.$idsuri})) {
    $hash{'ids_'.$idsuri}.=','.$rid;
       } else {
    $hash{'ids_'.$idsuri}=''.$rid;
       }
       
       if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard|viewclasslist)$/) {
    $turi.='?register=1';
       }
       
       $hash{'src_'.$rid}=$turi;
       
       if ($token->[2]->{'external'} eq 'true') {
    $hash{'ext_'.$rid}='true:';
       } else {
    $hash{'ext_'.$rid}='false:';
       }
       if ($token->[2]->{'type'}) {
    $hash{'type_'.$rid}=$token->[2]->{'type'};
    if ($token->[2]->{'type'} eq 'start') {
       $hash{'map_start_'.$uri}="$rid";
    }
    if ($token->[2]->{'type'} eq 'finish') {
       $hash{'map_finish_'.$uri}="$rid";
    }
       }  else {
    $hash{'type_'.$rid}='normal';
       }
       
       if (($turi=~/\.sequence$/) ||
    ($turi=~/\.page$/)) {
    $hash{'is_map_'.$rid}=1;
    &loadmap($turi,$rid);
       } 
       return $token->[2]->{'id'};
   }
   
                     $hash{'src_'.$rid}=$turi;  sub make_link {
       my ($linkpc,$lpc,$to,$from,$condition) = @_;
       
       my $linkid=$lpc.'.'.$linkpc;
       my $goesto=$lpc.'.'.$to;
       my $comesfrom=$lpc.'.'.$from;
       my $undercond=0;
   
                     if ($token->[2]->{'external'} eq 'true') {      if ($condition) {
                         $hash{'ext_'.$rid}='true:';   $undercond=$lpc.'.'.$condition;
                     } else {      }
                         $hash{'ext_'.$rid}='false:';  
                     }      $hash{'goesto_'.$linkid}=$goesto;
                     if ($token->[2]->{'type'}) {      $hash{'comesfrom_'.$linkid}=$comesfrom;
  $hash{'type_'.$rid}=$token->[2]->{'type'};      $hash{'undercond_'.$linkid}=$undercond;
                         if ($token->[2]->{'type'} eq 'start') {  
     $hash{'map_start_'.$uri}="$rid";      if (defined($hash{'to_'.$comesfrom})) {
                         }   $hash{'to_'.$comesfrom}.=','.$linkid;
                         if ($token->[2]->{'type'} eq 'finish') {      } else {
     $hash{'map_finish_'.$uri}="$rid";   $hash{'to_'.$comesfrom}=''.$linkid;
                         }      }
                     }  else {      if (defined($hash{'from_'.$goesto})) {
                         $hash{'type_'.$rid}='normal';   $hash{'from_'.$goesto}.=','.$linkid;
                     }      } else {
    $hash{'from_'.$goesto}=''.$linkid;
       }
   }
   
                     if (($turi=~/\.sequence$/) ||  
                         ($turi=~/\.page$/)) {  
                         $hash{'is_map_'.$rid}=1;  
                         &loadmap($turi);  
                     }   
                       
                 } elsif ($token->[1] eq 'condition') {  
 # ------------------------------------------------------------------- Condition  # ------------------------------------------------------------------- Condition
   sub parse_condition {
       my ($token,$lpc) = @_;
       my $rid=$lpc.'.'.$token->[2]->{'id'};
       
       $hash{'kind_'.$rid}='cond';
   
       my $condition = $token->[2]->{'value'};
       $condition =~ s/[\n\r]+/ /gs;
       push(@cond, $condition);
       $hash{'condid_'.$rid}=$#cond;
       if ($token->[2]->{'type'}) {
    $cond[$#cond].=':'.$token->[2]->{'type'};
       }  else {
    $cond[$#cond].=':normal';
       }
   }
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};  # ------------------------------------------------------------------- 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 ofr parameter (e.g. parameter_randompick or parameter_randomorder).
   #     value=xxx - value of the parameter.
   
   sub parse_param {
       my ($token,$lpc) = @_;
       my $referid=$lpc.'.'.$token->[2]->{'to'}; # Resource param applies to.
       my $name=$token->[2]->{'name'};      # Name of parameter
       my $part;
   
                     $hash{'kind_'.$rid}='cond';  
                     $cond[$#cond+1]=$token->[2]->{'value'};  
                     $hash{'condid_'.$rid}=$#cond;  
                     if ($token->[2]->{'type'}) {  
                         $cond[$#cond].=':'.$token->[2]->{'type'};  
                     }  else {  
                         $cond[$#cond].=':normal';  
                     }  
   
                 } elsif ($token->[1] eq 'link') {      if ($name=~/^parameter_(.*)_/) { 
 # ----------------------------------------------------------------------- Links   $part=$1;
       } else {
    $part=0;
       }
   
                     $linkpc++;      # Peel the parameter_ off the parameter name.
                     my $linkid=$lpc.'.'.$linkpc;  
   
                     my $goesto=$lpc.'.'.$token->[2]->{'to'};      $name=~s/^.*_([^_]*)$/$1/;
                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};  
                     my $undercond=0;  
   
                     if ($token->[2]->{'condition'}) {      # The value is:
  $undercond=$lpc.'.'.$token->[2]->{'condition'};      #   type.part.name.value
                     }  
   
                     $hash{'goesto_'.$linkid}=$goesto;      my $newparam=
                     $hash{'comesfrom_'.$linkid}=$comesfrom;   &escape($token->[2]->{'type'}).':'.
                     $hash{'undercond_'.$linkid}=$undercond;   &escape($part.'.'.$name).'='.
    &escape($token->[2]->{'value'});
                     if (defined($hash{'to_'.$comesfrom})) {  
                         $hash{'to_'.$comesfrom}.=','.$linkid;  
                     } else {  
                         $hash{'to_'.$comesfrom}=''.$linkid;  
                     }  
                     if (defined($hash{'from_'.$goesto})) {  
                         $hash{'from_'.$goesto}.=','.$linkid;  
                     } else {  
                         $hash{'from_'.$goesto}=''.$linkid;  
                     }  
                 } elsif ($token->[1] eq 'param') {  
 # ------------------------------------------------------------------- Parameter  
   
                     my $referid=$lpc.'.'.$token->[2]->{'to'};      # The hash key is param_resourceid.
     my $name=$token->[2]->{'name'};      # Multiple parameters for a single resource are & separated in the hash.
     my $part;  
     if ($name=~/^parameter_(.*)_/) {  
  $part=$1;  
     } else {  
  $part=0;  
     }  
     $name=~s/^.*_([^_]*)$/$1/;  
                     my $newparam=  
  &Apache::lonnet::escape($token->[2]->{'type'}).':'.  
  &Apache::lonnet::escape($part.'.'.$name).'='.  
  &Apache::lonnet::escape($token->[2]->{'value'});  
                     if (defined($hash{'param_'.$referid})) {  
                         $hash{'param_'.$referid}.='&'.$newparam;  
                     } else {  
                         $hash{'param_'.$referid}=''.$newparam;  
                     }  
                     if ($token->[2]->{'name'} eq 'parameter_mapalias') {  
  $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;  
                     }  
                     if ($token->[2]->{'name'} eq 'parameter_randompick') {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                     if ($token->[2]->{'name'} eq 'parameter_randompickseed') {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                 }   
   
             }  
         }  
   
       if (defined($hash{'param_'.$referid})) {
    $hash{'param_'.$referid}.='&'.$newparam;
     } else {      } else {
         $errtext.='Map not loaded: The file does not exist. ';   $hash{'param_'.$referid}=''.$newparam;
       }
       #
       #  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'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { # Randomseed provided.
    $randompickseed{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { # Random order turned on.
    $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]->{'value'}=~/^yes$/i) {
       $encurl{$referid}=1;
    }
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) {
    if ($token->[2]->{'value'}=~/^yes$/i) {
       $hiddenurl{$referid}=1;
    }
       }
   }
   
   sub parse_mapalias_param {
       my ($token,$lpc) = @_;
       my $referid=$lpc.'.'.$token->[2]->{'to'};
       return if (!exists($hash{'src_'.$referid}));
   
       if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) {
    &count_mapalias($token->[2]->{'value'},$referid);
    $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
     }      }
 }  }
   
 # --------------------------------------------------------- Simplify expression  # --------------------------------------------------------- Simplify expression
   
 sub simplify {  sub simplify {
    my $expression=shift;      my $expression=shift;
   # (0&1) = 1
       $expression=~s/\(0\&([_\.\d]+)\)/$1/g;
 # (8)=8  # (8)=8
    $expression=~s/\((\d+)\)/$1/g;      $expression=~s/\(([_\.\d]+)\)/$1/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;
 # 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))
    $expression=~      $expression=~
        s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;   s/\((\(\([_\.\d]+(?:\&[_\.\d]+)*\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+\))\)/$1/g;
 # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)  # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
    $expression=~      $expression=~
        s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;   s/\((\([_\.\d]+(?:\&[_\.\d]+)*\))((?:\|\([_\.\d]+(?:\&[_\.\d]+)*\))+)\)\|(\([_\.\d]+(?:\&[_\.\d]+)*\))/\($1$2\|$3\)/g;
    return $expression;      return $expression;
 }  }
   
 # -------------------------------------------------------- Build condition hash  # -------------------------------------------------------- Build condition hash
   
 sub traceroute {  sub traceroute {
     my ($sofar,$rid,$beenhere)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
     $sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
     unless ($beenhere=~/\&$rid\&/) {      unless ($beenhere=~/\&\Q$rid\E\&/) {
        $beenhere.=$rid.'&';     $beenhere.=$rid.'&';  
        if (($retfurl eq '') && ($hash{'src_'.$rid})   my ($mapid,$resid)=split(/\./,$rid);
         && ($hash{'src_'.$rid}!~/\.sequence$/)) {   my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
            my ($mapid,$resid)=split(/\./,$rid);   my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
            $retfurl=$hash{'src_'.$rid}.  
            (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='.   if ($hdnflag || lc($hidden) eq 'yes') {
            &Apache::lonnet::symbclean(      $hiddenurl{$rid}=1;
                            &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).   }
                            '___'.$resid.'___'.   if (!$hdnflag && lc($hidden) eq 'no') {
                            &Apache::lonnet::declutter($hash{'src_'.$rid}));      delete($hiddenurl{$rid});
        }   }
        if (defined($hash{'conditions_'.$rid})) {  
    $hash{'conditions_'.$rid}=simplify(   my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
    if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
    if (($retfrid eq '') && ($hash{'src_'.$rid})
       && ($hash{'src_'.$rid}!~/\.sequence$/)) {
       $retfrid=$rid;
    }
    if (defined($hash{'conditions_'.$rid})) {
       $hash{'conditions_'.$rid}=simplify(
            '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');             '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
        } else {   } else {
            $hash{'conditions_'.$rid}=$sofar;      $hash{'conditions_'.$rid}=$sofar;
        }   }
        if (defined($hash{'is_map_'.$rid})) {  
            if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {   # if the expression is just the 0th condition keep it
        &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');   # otherwise leave a pointer to this condition expression
                if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {   $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;
    $sofar=  
                   $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};   if (defined($hash{'is_map_'.$rid})) {
                }      if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
            }   $sofar=$newsofar=
        }      &traceroute($sofar,
        if (defined($hash{'to_'.$rid})) {   $hash{'map_start_'.$hash{'src_'.$rid}},
           foreach (split(/\,/,$hash{'to_'.$rid})) {   $beenhere,
    $encflag || $encurl{$rid},
    $hdnflag || $hiddenurl{$rid});
       }
    }
    if (defined($hash{'to_'.$rid})) {
       foreach my $id (split(/\,/,$hash{'to_'.$rid})) {
  my $further=$sofar;   my $further=$sofar;
                 if ($hash{'undercond_'.$_}) {                  if ($hash{'undercond_'.$id}) {
    if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {      if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) {
         $further=simplify('('.$further.')&('.   $further=simplify('('.'_'.$rid.')&('.
                               $hash{'condid_'.$hash{'undercond_'.$_}}.')');    $hash{'condid_'.$hash{'undercond_'.$id}}.')');
    } else {      } else {
                        $errtext.='Undefined condition ID: '   $errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id});
                                  .$hash{'undercond_'.$_}.'. ';      }
                    }  
                 }                  }
                 &traceroute($further,$hash{'goesto_'.$_},$beenhere);                  $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,
           }        $encflag,$hdnflag);
        }      }
    }
     }      }
       return $newsofar;
 }  }
   
 # ------------------------------ Cascading conditions, quick access, parameters  # ------------------------------ Cascading conditions, quick access, parameters
Line 370  sub accinit { Line 654  sub accinit {
     my %captured=();      my %captured=();
     my $condcounter=0;      my $condcounter=0;
     $acchash{'acc.cond.'.$short.'.0'}=0;      $acchash{'acc.cond.'.$short.'.0'}=0;
     foreach (keys %hash) {      foreach my $key (keys(%hash)) {
        if ($_=~/^conditions/) {   if ($key=~/^conditions/) {
   my $expr=$hash{$_};      my $expr=$hash{$key};
          foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) {      # try to find and factor out common sub-expressions
              my $sub=$_;      foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) {
              my $orig=$_;   my $orig=$sub;
       $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;  
              my $factor=$1;   my ($factor) = ($sub=~/\(\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+\)(?:\|\(\1(?:[_\.\d]+\&*)+\))+\)/);
              $sub=~s/$factor//g;   next if (!defined($factor));
              $sub=~s/^\(/\($factor\(/;  
      $sub.=')';   $sub=~s/\Q$factor\E//g;
              $sub=simplify($sub);   $sub=~s/^\(/\($factor\(/;
              $orig=~s/(\W)/\\$1/g;   $sub.=')';
       $expr=~s/$orig/$sub/;   $sub=simplify($sub);
   }   $expr=~s/\Q$orig\E/$sub/;
           $hash{$_}=$expr;      }
           unless (defined($captured{$expr})) {      $hash{$key}=$expr;
       $condcounter++;      unless (defined($captured{$expr})) {
               $captured{$expr}=$condcounter;   $condcounter++;
               $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;   $captured{$expr}=$condcounter;
           }    $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
        } elsif ($_=~/^param_(\d+)\.(\d+)/) {      } 
           my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}).   } elsif ($key=~/^param_(\d+)\.(\d+)/) {
       '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});      my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,
           foreach (split(/\&/,$hash{$_})) {      $hash{'src_'.$1.'.'.$2});
      my ($typename,$value)=split(/\=/,$_);      foreach my $param (split(/\&/,$hash{$key})) {
              my ($type,$name)=split(/\:/,$typename);   my ($typename,$value)=split(/\=/,$param);
              $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=   my ($type,$name)=split(/\:/,$typename);
                                    &Apache::lonnet::unescape($value);   $parmhash{$prefix.'.'.&unescape($name)}=
      $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=      &unescape($value);
                                    &Apache::lonnet::unescape($type);   $parmhash{$prefix.'.'.&unescape($name).'.type'}=
           }      &unescape($type);
        }      }
     }   }
     foreach (keys %hash) {      }
  if ($_=~/^ids/) {      foreach my $key (keys(%hash)) {
   foreach (split(/\,/,$hash{$_})) {   if ($key=~/^ids/) {
     my $resid=$_;      foreach my $resid (split(/\,/,$hash{$key})) {
             my $uri=$hash{'src_'.$resid};   my $uri=$hash{'src_'.$resid};
             $uri=~s/^\/adm\/wrapper//;   my ($uripath,$urifile) =
             $uri=&Apache::lonnet::declutter($uri);      &Apache::lonnet::split_uri_for_cond($uri);
             my @uriparts=split(/\//,$uri);   if ($uripath) {
             my $urifile=$uriparts[$#uriparts];      my $uricond='0';
             $#uriparts--;      if (defined($hash{'conditions_'.$resid})) {
             my $uripath=join('/',@uriparts);   $uricond=$captured{$hash{'conditions_'.$resid}};
            if ($uripath) {      }
             my $uricond='0';      if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
             if (defined($hash{'conditions_'.$resid})) {   if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
   $uricond=$captured{$hash{'conditions_'.$resid}};      /(\&\Q$urifile\E\:[^\&]*)/) {
             }      my $replace=$1;
             if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {      my $regexp=$replace;
                 if ($acchash{'acc.res.'.$short.'.'.$uripath}=~      #$regexp=~s/\|/\\\|/g;
                    /(\&\Q$urifile\E\:[^\&]*)/) {      $acchash{'acc.res.'.$short.'.'.$uripath} =~
     my $replace=$1;   s/\Q$regexp\E/$replace\|$uricond/;
                     my $regexp=$replace;   } else {
                     $regexp=~s/\|/\\\|/g;      $acchash{'acc.res.'.$short.'.'.$uripath}.=
                     $acchash{'acc.res.'.$short.'.'.$uripath}   $urifile.':'.$uricond.'&';
                      =~s/$regexp/$replace\|$uricond/;   }
                 } else {      } else {
    $acchash{'acc.res.'.$short.'.'.$uripath}.=   $acchash{'acc.res.'.$short.'.'.$uripath}=
                      $urifile.':'.$uricond.'&';      '&'.$urifile.':'.$uricond.'&';
         }      }
             } else {   } 
                 $acchash{'acc.res.'.$short.'.'.$uripath}=      }
                  '&'.$urifile.':'.$uricond.'&';   }
             }  
            }   
          }  
       }  
     }      }
     $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);
                             "request.course.id"  => $short,      &Apache::lonnet::appenv(\%acchash);
                             "request.course.fn"  => $fn,  
                             "request.course.uri" => $courseuri);   
 }  }
   
 # ------------------------------------- Selectively delete from randompick maps  # ---------------- Selectively delete from randompick maps and hidden url parms
   
 sub pickrandom {  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
         my @currentrids=();          my @currentrids=();
         foreach (sort(keys(%hash))) {          foreach my $key (sort(keys(%hash))) {
     if ($_=~/^src_($mpc\.\d+)/) {      if ($key=~/^src_($mpc\.\d+)/) {
  if ($hash{'src_'.$1}) { push @currentrids, $1; }   if ($hash{'src_'.$1}) { push @currentrids, $1; }
             }              }
         }          }
Line 486  sub pickrandom { Line 764  sub pickrandom {
  $hash{'randomout_'.$currentrids[$k]}=1;   $hash{'randomout_'.$currentrids[$k]}=1;
                 my ($mapid,$resid)=split(/\./,$currentrids[$k]);                  my ($mapid,$resid)=split(/\./,$currentrids[$k]);
                 $randomoutentry.='&'.                  $randomoutentry.='&'.
                  &Apache::lonnet::symbclean(      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
     &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).   $resid,
                     '___'.$resid.'___'.   $hash{'src_'.$currentrids[$k]}
     &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})   ).'&';
                  ).'&';  
             }              }
         }          }
     }      }
   # ------------------------------ take care of explicitly hidden urls or folders
       foreach my $rid (keys %hiddenurl) {
    $hash{'randomout_'.$rid}=1;
    my ($mapid,$resid)=split(/\./,$rid);
    $randomoutentry.='&'.
       &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
    $hash{'src_'.$rid}).'&';
       }
   # --------------------------------------- append randomout entry to environment
     if ($randomoutentry) {      if ($randomoutentry) {
  &Apache::lonnet::appenv('acc.randomout' => $randomoutentry);   &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry});
     }      }
 }  }
   
 # ---------------------------------------------------- Read map and all submaps  # ---------------------------------------------------- Read map and all submaps
   
 sub readmap {  sub readmap {
    my $short=shift;      my $short=shift;
    $short=~s/^\///;      $short=~s/^\///;
    my %cenv=&Apache::lonnet::coursedescription($short);  
    my $fn=$cenv{'fn'};      # TODO:  Hidden dependency on current user:
    my $uri;  
    $short=~s/\//\_/g;      my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); 
    unless ($uri=$cenv{'url'}) {   
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".      my $fn=$cenv{'fn'};
                        "Could not load course $short.</font>");       my $uri;
       return 'No course data available.';      $short=~s/\//\_/g;
    }      unless ($uri=$cenv{'url'}) { 
    @cond=('true:normal');   &Apache::lonnet::logthis('<font color="blue">WARNING: '.
    unlink($fn.'.db');   "Could not load course $short.</font>"); 
    unlink($fn.'_symb.db');   return ('',&mt('No course data available.'));;
    unlink($fn.'.state');      }
    unlink($fn.'parms.db');      @cond=('true:normal');
    undef %randompick;  
    $retfurl='';      unless (open(LOCKFILE,">$fn.db.lock")) {
    if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&   # 
        (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {   # Most likely a permissions problem on the lockfile or its directory.
     %hash=();   #
           $errtext.='<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.';
           $retfurl = '';
           return ($retfurl,$errtext);
       }
       my $lock=0;
       my $gotstate=0;
       
       # If we can get the lock without delay any files there are idle
       # and from some prior request.  We'll kill them off and regenerate them:
   
       if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
    $lock=1; # Remember that we hold the lock.
           &unlink_tmpfiles($fn);
       }
       undef %randompick;
       undef %hiddenurl;
       undef %encurl;
       $retfrid='';
       my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash); # More state flags.
   
       # if we got the lock, regenerate course regnerate empty files and tie them.
   
       if ($lock) {
           if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
               $tiedhash = 1;
               if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
                   $tiedparmhash = 1;
                   $gotstate = &build_tmp_hashes($uri,
         $fn,
         $short,
         \%cenv); # TODO: Need to provide requested user@dom
                   unless ($gotstate) {
                       &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');
                   }
                   $untiedparmhash = untie(%parmhash);
                   unless ($untiedparmhash) {
                       &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                           'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.</font>');
                   }
               }
               $untiedhash = untie(%hash);
               unless ($untiedhash) {
                   &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                       'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
               }
           }
    flock(LOCKFILE,LOCK_UN); # RF: this is what I don't get unless there are other
                            # unlocked places the remainder happens..seems like if we
                                    # just kept the lock here the rest of the code would have
                                    # been much easier? 
       }
       unless ($lock && $tiedhash && $tiedparmhash) { 
    # if we are here it is likely because we are already trying to 
    # initialize the course in another child, busy wait trying to 
    # 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 
    # 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) {
       # Got the lock but not the DB files
       flock(LOCKFILE,LOCK_UN);
               $lock = 0;
    }
           if ($tiedhash) {
               unless($untiedhash) {
           untie(%hash);
               }
           }
           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;
   
    # Keep on retrying the lock for 90 sec until we succeed.
   
    while($i<90) {
       $i++;
       sleep(1);
       if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
   
    # Got the lock, tie the hashes...the assumption in this code is
    # that some other worker thread has created the db files quite recently
    # so no load is needed:
   
                   $lock = 1;
    if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
                       $tiedhash = 1;
       if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
                           $tiedparmhash = 1;
                           if (-e "$fn.state") {
               $retfurl='/adm/navmaps';
   
       # 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});
               $untiedhash = untie(%hash);
               $untiedparmhash = untie(%parmhash);
                               $gotstate = 1;
               last;
           }
                           $untiedparmhash = untie(%parmhash);
               }
               $untiedhash = untie(%hash);
                   }
               }
    }
           if ($lock) {
               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 %hiddenurl;
           undef %encurl;
           $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?
       }
   # ------------------------------------------------- Check for critical messages
   
   #  Depends on user must parameterize this as well..or separate as this is:
   #  more part of determining what someone sees on entering a course?
   
       my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
      $env{'user.name'});
       if ($what[0]) {
    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
       $retfurl='/adm/email?critical=display';
           }
       }
       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=();      %parmhash=();
     $errtext='';      $errtext=''; # No error messages yet.
     $pc=0;      $pc=0;
       &clear_mapalias_count();
     &processversionfile(%cenv);      &processversionfile(%cenv);
     my $furi=&Apache::lonnet::clutter($uri);      my $furi=&Apache::lonnet::clutter($uri);
       #
       #  the map staring points.
       #
     $hash{'src_0.0'}=&versiontrack($furi);      $hash{'src_0.0'}=&versiontrack($furi);
     $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');      $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
     $hash{'ids_'.$furi}='0.0';      $hash{'ids_'.$furi}='0.0';
     $hash{'is_map_0.0'}=1;      $hash{'is_map_0.0'}=1;
     loadmap($uri);      &loadmap($uri,'0.0');
     if (defined($hash{'map_start_'.$uri})) {      if (defined($hash{'map_start_'.$uri})) {
           &Apache::lonnet::appenv({"request.course.id"  => $short,
                                    "request.course.fn"  => $fn,
                                    "request.course.uri" => $uri});
           $env{'request.course.id'}=$short;
         &traceroute('0',$hash{'map_start_'.$uri},'&');          &traceroute('0',$hash{'map_start_'.$uri},'&');
         &accinit($uri,$short,$fn);          &accinit($uri,$short,$fn);
         &pickrandom();          &hiddenurls();
     }      }
       $errtext .= &get_mapalias_errors();
 # ------------------------------------------------------- Put versions into src  # ------------------------------------------------------- Put versions into src
     foreach (keys %hash) {      foreach my $key (keys(%hash)) {
  if ($_=~/^src\_/) {          if ($key=~/^src_/) {
     $hash{$_}=&putinversion($hash{$_});              $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;
           }
     }      }
     unless ((untie(%hash)) && (untie(%parmhash))) {  # ---------------------------------------------------------------- Encrypt URLs
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".      foreach my $id (keys(%encurl)) {
                        "Could not untie coursemap $fn for $uri.</font>");   #           $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;          my $cfh;
      if ($cfh=Apache::File->new(">$fn.state")) {          if (open($cfh,">$fn.state")) {
         print $cfh join("\n",@cond);              print $cfh join("\n",@cond);
      } else {              $gotstate = 1;
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".          } else {
                        "Could not write statemap $fn for $uri.</font>");               &Apache::lonnet::logthis("<font color=blue>WARNING: ".
      }                                       "Could not write statemap $fn for $uri.</font>");
     }            }
    } else {      }
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".      return $gotstate;
                        "Could not tie coursemap $fn for $uri.</font>");   }
    }  
    &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);  
 # ------------------------------------------------- Check for critical messages  
   
     my @what=&Apache::lonnet::dump('critical',$ENV{'user.domain'},  sub unlink_tmpfiles {
                                               $ENV{'user.name'});      my ($fn) = @_;
     if ($what[0]) {      my $file_dir = dirname($fn);
  if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {  
     $retfurl='/adm/email?critical=display';      if ($fn 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 ($retfurl,$errtext);      return;
 }  }
   
 # ------------------------------------------------------- Evaluate state string  # ------------------------------------------------------- Evaluate state string
   
 sub evalstate {  sub evalstate {
       my $fn=$env{'request.course.fn'}.'.state';
     my $fn=$ENV{'request.course.fn'}.'.state';      my $state='';
     my $state='2';  
     if (-e $fn) {      if (-e $fn) {
        my @conditions=();   my @conditions=();
        {   {
         my $fh=Apache::File->new($fn);      open(my $fh,"<$fn");
         @conditions=<$fh>;      @conditions=<$fh>;
        }                close($fh);
        my $safeeval = new Safe;   }  
        my $safehole = new Safe::Hole;   my $safeeval = new Safe;
        $safeeval->permit("entereval");   my $safehole = new Safe::Hole;
        $safeeval->permit(":base_math");   $safeeval->permit("entereval");
        $safeeval->deny(":base_io");   $safeeval->permit(":base_math");
        $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');   $safeeval->deny(":base_io");
        foreach (@conditions) {   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
    my $line=$_;   foreach my $line (@conditions) {
            chomp($line);      chomp($line);
    my ($condition,$weight)=split(/\:/,$_);      my ($condition,$weight)=split(/\:/,$line);
            if ($safeeval->reval($condition)) {      if ($safeeval->reval($condition)) {
        if ($weight eq 'force') {   if ($weight eq 'force') {
    $state.='3';      $state.='3';
                } else {   } else {
                    $state.='2';      $state.='2';
                }   }
            } else {      } else {
                if ($weight eq 'stop') {   if ($weight eq 'stop') {
    $state.='0';      $state.='0';
                } else {   } else {
                    $state.='1';      $state.='1';
                }   }
            }      }
        }   }
     }      }
     &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);      &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state});
     return $state;      return $state;
 }  }
   
   #  This block seems to have code to manage/detect doubly defined
   #  aliases in maps.
   
   {
       my %mapalias_cache;
       sub count_mapalias {
    my ($value,$resid) = @_;
     push(@{ $mapalias_cache{$value} }, $resid);
       }
   
       sub get_mapalias_errors {
    my $error_text;
    foreach my $mapalias (sort(keys(%mapalias_cache))) {
       next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1);
       my $count;
       my $which =
    join('</li><li>', 
        map {
    my $id = $_;
    if (exists($hash{'src_'.$id})) {
        $count++;
    }
    my ($mapid) = split(/\./,$id);
                            &mt('Resource "[_1]" <br /> in Map "[_2]"',
        $hash{'title_'.$id},
        $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
        } (@{ $mapalias_cache{$mapalias} }));
       next if ($count < 2);
       $error_text .= '<div class="LC_error">'.
    &mt('Error: Found the mapalias "[_1]" defined multiple times.',
       $mapalias).
    '</div><ul><li>'.$which.'</li></ul>';
    }
    &clear_mapalias_count();
    return $error_text;
       }
       sub clear_mapalias_count {
    undef(%mapalias_cache);
       }
   }
 1;  1;
 __END__  __END__
   
Line 637  of course for user. Line 1231  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.69  
changed lines
  Added in v.1.138


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