[BACK]Return to lonuserstate.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

Diff for /rat/lonuserstate.pm between versions 1.95 and 1.135

version 1.95, 2005/07/15 12:29:07 version 1.135, 2010/03/25 17:38:52
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 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;
Line 41  use Safe; Line 41  use Safe;
 use Safe::Hole;  use Safe::Hole;
 use Opcode;  use Opcode;
 use Apache::lonenc;  use Apache::lonenc;
   use Fcntl qw(:flock);
   use LONCAPA;
    
   
 # ---------------------------------------------------- Globals for this package  # ---------------------------------------------------- Globals for this package
   
Line 49  my %hash;    # The big tied hash Line 52  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 %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
   
 # ----------------------------------- 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 64  sub versiontrack { Line 75  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 93  sub processversionfile { Line 106  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 map from disk
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my ($uri,$parent_rid)=@_;
     if ($hash{'map_pc_'.$uri}) { return OK; }      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; 
       }
     $pc++;      $pc++;
     my $lpc=$pc;      my $lpc=$pc;
     $hash{'map_pc_'.$uri}=$lpc;      $hash{'map_pc_'.$uri}=$lpc;
Line 117  sub loadmap { Line 134  sub loadmap {
   
     unless (($fn=~/\.sequence$/) ||      unless (($fn=~/\.sequence$/) ||
             ($fn=~/\.page$/)) {               ($fn=~/\.page$/)) { 
  $errtext.="Invalid map: $fn\n";   $errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn);
  return OK;    return; 
     }      }
   
     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  # Successfully got file, parse it
   
         my $parser = HTML::TokeParser->new(\$instr);      my $parser = HTML::TokeParser->new(\$instr);
  $parser->attr_encoded(1);      $parser->attr_encoded(1);
         my $token;      # first get all parameters
       while (my $token = $parser->get_token) {
         my $linkpc=0;   next if ($token->[0] ne 'S');
    if ($token->[1] eq 'param') {
       &parse_param($token,$lpc);
    } 
       }
       #reset parser
       $parser = HTML::TokeParser->new(\$instr);
       $parser->attr_encoded(1);
   
       my $linkpc=0;
   
       $fn=~/\.(\w+)$/;
   
       $hash{'map_type_'.$lpc}=$1;
   
       my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
   
       my @map_ids;
       while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
    if ($token->[1] eq 'resource') {
       push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri));
    } elsif ($token->[1] eq 'link' && !$randomize) {
   # ----------------------------------------------------------------------- Links
       &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
          $token->[2]->{'from'},
          $token->[2]->{'condition'});
    } elsif ($token->[1] eq 'condition' && !$randomize) {
       &parse_condition($token,$lpc);
    }
       }
   
         $fn=~/\.(\w+)$/;      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;
       }
   
       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
                     if ($token->[2]->{'type'} eq 'zombie') { next; }  sub parse_resource {
                     my $rid=$lpc.'.'.$token->[2]->{'id'};      my ($token,$lpc,$ispage,$uri) = @_;
       if ($token->[2]->{'type'} eq 'zombie') { next; }
                     $hash{'kind_'.$rid}='res';      my $rid=$lpc.'.'.$token->[2]->{'id'};
                     $hash{'title_'.$rid}=$token->[2]->{'title'};      
                     my $turi=&versiontrack($token->[2]->{'src'});      $hash{'kind_'.$rid}='res';
                     if ($token->[2]->{'version'}) {      $hash{'title_'.$rid}=$token->[2]->{'title'};
  unless ($hash{'version_'.$turi}) {      my $turi=&versiontrack($token->[2]->{'src'});
     $hash{'version_'.$turi}=$1;      if ($token->[2]->{'version'}) {
  }   unless ($hash{'version_'.$turi}) {
     }      $hash{'version_'.$turi}=$1;
     my $title=$token->[2]->{'title'};   }
     $title=~s/\&colon\;/\:/gs;      }
 #    my $symb=&Apache::lonnet::encode_symb($uri,      my $title=$token->[2]->{'title'};
 #  $token->[2]->{'id'},      $title=~s/\&colon\;/\:/gs;
 #  $turi);  #   my $symb=&Apache::lonnet::encode_symb($uri,
 #    &Apache::lonnet::do_cache_new('title',$symb,$title);  #  $token->[2]->{'id'},
                     unless ($ispage) {  #  $turi);
                         $turi=~/\.(\w+)$/;  #   &Apache::lonnet::do_cache_new('title',$symb,$title);
                         my $embstyle=&Apache::loncommon::fileembstyle($1);      unless ($ispage) {
                         if ($token->[2]->{'external'} eq 'true') { # external   $turi=~/\.(\w+)$/;
                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;   my $embstyle=&Apache::loncommon::fileembstyle($1);
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded   if ($token->[2]->{'external'} eq 'true') { # external
     if (($embstyle eq 'img') || ($embstyle eq 'emb')) {      $turi=~s/^https?\:\/\//\/adm\/wrapper\/ext\//;
                                 $turi='/adm/wrapper'.$turi;   } elsif ($turi=~/^\/*uploaded\//) { # uploaded
     } elsif ($embstyle eq 'ssi') {      if (($embstyle eq 'img') 
  #do nothing with these   || ($embstyle eq 'emb')
     } elsif ($turi!~/\.(sequence|page)$/) {   || ($embstyle eq 'wrp')) {
  $turi='/adm/coursedocs/showdoc'.$turi;   $turi='/adm/wrapper'.$turi;
                             }      } elsif ($embstyle eq 'ssi') {
                         } elsif ($turi=~/\S/) { # normal non-empty internal resource   #do nothing with these
     my $mapdir=$uri;      } elsif ($turi!~/\.(sequence|page)$/) {
     $mapdir=~s/[^\/]+$//;   $turi='/adm/coursedocs/showdoc'.$turi;
     $turi=&Apache::lonnet::hreflocation($mapdir,$turi);      }
     if (($embstyle eq 'img') || ($embstyle eq 'emb')) {   } elsif ($turi=~/\S/) { # normal non-empty internal resource
  $turi='/adm/wrapper'.$turi;      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  # Store reverse lookup, remove query string
     my $idsuri=$turi;      my $idsuri=$turi;
     $idsuri=~s/\?.+$//;      $idsuri=~s/\?.+$//;
                     if (defined($hash{'ids_'.$idsuri})) {      if (defined($hash{'ids_'.$idsuri})) {
                         $hash{'ids_'.$idsuri}.=','.$rid;   $hash{'ids_'.$idsuri}.=','.$rid;
                     } else {      } else {
                         $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';
     }      }
       
       $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 ($condition) {
    $undercond=$lpc.'.'.$condition;
       }
   
       $hash{'goesto_'.$linkid}=$goesto;
       $hash{'comesfrom_'.$linkid}=$comesfrom;
       $hash{'undercond_'.$linkid}=$undercond;
   
                     if ($token->[2]->{'external'} eq 'true') {      if (defined($hash{'to_'.$comesfrom})) {
                         $hash{'ext_'.$rid}='true:';   $hash{'to_'.$comesfrom}.=','.$linkid;
                     } else {      } else {
                         $hash{'ext_'.$rid}='false:';   $hash{'to_'.$comesfrom}=''.$linkid;
                     }      }
                     if ($token->[2]->{'type'}) {      if (defined($hash{'from_'.$goesto})) {
  $hash{'type_'.$rid}=$token->[2]->{'type'};   $hash{'from_'.$goesto}.=','.$linkid;
                         if ($token->[2]->{'type'} eq 'start') {      } else {
     $hash{'map_start_'.$uri}="$rid";   $hash{'from_'.$goesto}=''.$linkid;
                         }      }
                         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);  
                     }   
                       
                 } 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'};  
   
                     $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') {  
 # ----------------------------------------------------------------------- Links  
   
                     $linkpc++;  
                     my $linkid=$lpc.'.'.$linkpc;  
   
                     my $goesto=$lpc.'.'.$token->[2]->{'to'};  
                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};  
                     my $undercond=0;  
   
                     if ($token->[2]->{'condition'}) {  
  $undercond=$lpc.'.'.$token->[2]->{'condition'};  
                     }  
   
                     $hash{'goesto_'.$linkid}=$goesto;  
                     $hash{'comesfrom_'.$linkid}=$comesfrom;  
                     $hash{'undercond_'.$linkid}=$undercond;  
   
                     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  # ------------------------------------------------------------------- Parameter
   
                     my $referid=$lpc.'.'.$token->[2]->{'to'};  sub parse_param {
     my $name=$token->[2]->{'name'};      my ($token,$lpc) = @_;
     my $part;      my $referid=$lpc.'.'.$token->[2]->{'to'};
     if ($name=~/^parameter_(.*)_/) {      my $name=$token->[2]->{'name'};
  $part=$1;      my $part;
     } else {      if ($name=~/^parameter_(.*)_/) {
  $part=0;   $part=$1;
     }  
     $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'}=~/^parameter_(0_)*mapalias$/) {  
  $hash{'mapalias_'.$token->[2]->{'value'}}=$referid;  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                     if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {  
  $randompick{$referid}=$token->[2]->{'value'};  
                     }  
                     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;  
  }  
                     }  
                 }   
   
             }  
         }  
   
     } else {      } else {
         $errtext.='Map not loaded: The file ('.$fn.') does not exist. ';   $part=0;
       }
       $name=~s/^.*_([^_]*)$/$1/;
       my $newparam=
    &escape($token->[2]->{'type'}).':'.
    &escape($part.'.'.$name).'='.
    &escape($token->[2]->{'value'});
       if (defined($hash{'param_'.$referid})) {
    $hash{'param_'.$referid}.='&'.$newparam;
       } else {
    $hash{'param_'.$referid}=''.$newparam;
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) {
    $randompick{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) {
    $randompickseed{$referid}=$token->[2]->{'value'};
       }
       if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) {
    $randomorder{$referid}=$token->[2]->{'value'};
       }
       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;
     }      }
 }  }
   
Line 314  sub loadmap { Line 421  sub loadmap {
   
 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;
 }  }
   
Line 336  sub simplify { Line 445  sub simplify {
 sub traceroute {  sub traceroute {
     my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
     my $newsofar=$sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
     unless ($beenhere=~/\&$rid\&/) {      unless ($beenhere=~/\&\Q$rid\E\&/) {
  $beenhere.=$rid.'&';     $beenhere.=$rid.'&';  
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
  my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});   my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
Line 351  sub traceroute { Line 460  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 (($retfurl eq '') && ($hash{'src_'.$rid})   if (($retfrid eq '') && ($hash{'src_'.$rid})
     && ($hash{'src_'.$rid}!~/\.sequence$/)) {      && ($hash{'src_'.$rid}!~/\.sequence$/)) {
     $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').      $retfrid=$rid;
  'symb='.$symb;  
  }   }
  if (defined($hash{'conditions_'.$rid})) {   if (defined($hash{'conditions_'.$rid})) {
     $hash{'conditions_'.$rid}=simplify(      $hash{'conditions_'.$rid}=simplify(
Line 362  sub traceroute { Line 470  sub traceroute {
  } else {   } else {
     $hash{'conditions_'.$rid}=$sofar;      $hash{'conditions_'.$rid}=$sofar;
  }   }
  $newsofar=$hash{'conditions_'.$rid};  
    # if the expression is just the 0th condition keep it
    # otherwise leave a pointer to this condition expression
    $newsofar = ($sofar eq '0') ? $sofar : '_'.$rid;
   
  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});
     }      }
  }   }
  if (defined($hash{'to_'.$rid})) {   if (defined($hash{'to_'.$rid})) {
     foreach (split(/\,/,$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_'.$_}.'. ';  
     }      }
                 }                  }
                 $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere,                  $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere,
       $encflag,$hdnflag);        $encflag,$hdnflag);
     }      }
  }   }
Line 400  sub accinit { Line 512  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/\Q$factor\E//g;
  $sub=~s/^\(/\($factor\(/;   $sub=~s/^\(/\($factor\(/;
  $sub.=')';   $sub.=')';
  $sub=simplify($sub);   $sub=simplify($sub);
  $orig=~s/(\W)/\\$1/g;   $expr=~s/\Q$orig\E/$sub/;
  $expr=~s/$orig/$sub/;  
     }      }
     $hash{$_}=$expr;      $hash{$key}=$expr;
     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;
     }       } 
  } elsif ($_=~/^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});
     foreach (split(/\&/,$hash{$_})) {      foreach my $param (split(/\&/,$hash{$key})) {
  my ($typename,$value)=split(/\=/,$_);   my ($typename,$value)=split(/\=/,$param);
  my ($type,$name)=split(/\:/,$typename);   my ($type,$name)=split(/\:/,$typename);
  $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=   $parmhash{$prefix.'.'.&unescape($name)}=
     &Apache::lonnet::unescape($value);      &unescape($value);
  $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=   $parmhash{$prefix.'.'.&unescape($name).'.type'}=
     &Apache::lonnet::unescape($type);      &unescape($type);
     }      }
  }   }
     }      }
     foreach (keys %hash) {      foreach my $key (keys(%hash)) {
  if ($_=~/^ids/) {   if ($key=~/^ids/) {
     foreach (split(/\,/,$hash{$_})) {      foreach my $resid (split(/\,/,$hash{$key})) {
  my $resid=$_;  
  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);  
  my $urifile=$uriparts[$#uriparts];  
  $#uriparts--;  
  my $uripath=join('/',@uriparts);  
  if ($uripath) {   if ($uripath) {
     my $uricond='0';      my $uricond='0';
     if (defined($hash{'conditions_'.$resid})) {      if (defined($hash{'conditions_'.$resid})) {
Line 456  sub accinit { Line 564  sub accinit {
     my $replace=$1;      my $replace=$1;
     my $regexp=$replace;      my $regexp=$replace;
     #$regexp=~s/\|/\\\|/g;      #$regexp=~s/\|/\\\|/g;
     $acchash{'acc.res.'.$short.'.'.$uripath}      $acchash{'acc.res.'.$short.'.'.$uripath} =~
     =~s/\Q$regexp\E/$replace\|$uricond/;   s/\Q$regexp\E/$replace\|$uricond/;
  } else {   } else {
     $acchash{'acc.res.'.$short.'.'.$uripath}.=      $acchash{'acc.res.'.$short.'.'.$uripath}.=
  $urifile.':'.$uricond.'&';   $urifile.':'.$uricond.'&';
Line 473  sub accinit { Line 581  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
Line 486  sub hiddenurls { Line 595  sub hiddenurls {
         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 530  sub hiddenurls { Line 639  sub hiddenurls {
     }      }
 # --------------------------------------- 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});
     }      }
 }  }
   
Line 539  sub hiddenurls { Line 648  sub hiddenurls {
 sub readmap {  sub readmap {
     my $short=shift;      my $short=shift;
     $short=~s/^\///;      $short=~s/^\///;
     my %cenv=&Apache::lonnet::coursedescription($short);      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 'No course data available.';   return ('',&mt('No course data available.'));;
     }      }
     @cond=('true:normal');      @cond=('true:normal');
     #unlink($fn.'.db');  
     #unlink($fn.'_symb.db');      unless (open(LOCKFILE,">$fn.db.lock")) {
     unlink($fn.'.state');          $errtext.='<br />'.&mt('Map not loaded - Lock file could not be opened when reading map:').' <tt>'.$fn.'</tt>.';
     unlink($fn.'parms.db');          $retfurl = '';
           return ($retfurl,$errtext);
       }
       my $lock=0;
       my $gotstate=0;
       if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
    $lock=1;
           &unlink_tmpfiles($fn);
       }
     undef %randompick;      undef %randompick;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
     $retfurl='';      $retfrid='';
     if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&      my ($untiedhash,$untiedparmhash,$tiedhash,$tiedparmhash);
  (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {      if ($lock) {
  %hash=();          if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) {
  %parmhash=();              $tiedhash = 1;
  $errtext='';              if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640)) {
  $pc=0;                  $tiedparmhash = 1;
  &processversionfile(%cenv);                  $gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv);
  my $furi=&Apache::lonnet::clutter($uri);                  unless ($gotstate) {
  $hash{'src_0.0'}=&versiontrack($furi);                      &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');
  $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');                  }
  $hash{'ids_'.$furi}='0.0';                  $untiedparmhash = untie(%parmhash);
  $hash{'is_map_0.0'}=1;                  unless ($untiedparmhash) {
  loadmap($uri);                      &Apache::lonnet::logthis('<font color="blue">WARNING: '.
  if (defined($hash{'map_start_'.$uri})) {                          'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.</font>');
     &Apache::lonnet::appenv("request.course.id"  => $short,                  }
     "request.course.fn"  => $fn,              }
     "request.course.uri" => $uri);              $untiedhash = untie(%hash);
     &traceroute('0',$hash{'map_start_'.$uri},'&');              unless ($untiedhash) {
     &accinit($uri,$short,$fn);                  &Apache::lonnet::logthis('<font color="blue">WARNING: '.
     &hiddenurls();                      'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
  }              }
 # ------------------------------------------------------- Put versions into src          }
  foreach (keys %hash) {   flock(LOCKFILE,LOCK_UN);
     if ($_=~/^src\_/) {      }
  $hash{$_}=&putinversion($hash{$_});      unless ($lock && $tiedhash && $tiedparmhash) { 
     }  
  }  
 # ---------------------------------------------------------------- Encrypt URLs  
  foreach (keys %encurl) {  
 #    $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_});  
     $hash{'encrypted_'.$_}=1;  
  }  
 # ----------------------------------------------- Close hashes to finally store  
 # --------------------------------- Routine must pass this point, no early outs  
  $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>");   
     }  
  }    
     } 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
  untie(%hash);   if ($lock) {
  untie(%parmhash);      # Got the lock but not the DB files
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".      flock(LOCKFILE,LOCK_UN);
  "Could not tie coursemap $fn for $uri.</font>");               $lock = 0;
    }
           if ($tiedhash) {
               unless($untiedhash) {
           untie(%hash);
               }
           }
           if ($tiedparmhash) {
               unless($untiedparmhash) {
                   untie(%parmhash);
               }
           }
    &Apache::lonnet::logthis('<font color="blue">WARNING: '.
    "Could not tie coursemap $fn for $uri.</font>");
           $tiedhash = '';
           $tiedparmhash = '';
  my $i=0;   my $i=0;
  while($i<90) {   while($i<90) {
     $i++;      $i++;
     sleep(1);      sleep(1);
     if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
  if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {                  $lock = 1;
     $retfurl='/adm/navmaps';   if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
     &Apache::lonnet::appenv("request.course.id"  => $short,                      $tiedhash = 1;
     "request.course.fn"  => $fn,      if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
     "request.course.uri" => $uri);                          $tiedparmhash = 1;
     untie(%hash);                          if (-e "$fn.state") {
     untie(%parmhash);              $retfurl='/adm/navmaps';
     last;              &Apache::lonnet::appenv({"request.course.id"  => $short,
  }                 "request.course.fn"  => $fn,
     }               "request.course.uri" => $uri});
     untie(%hash);              $untiedhash = untie(%hash);
     untie(%parmhash);              $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>');
                   }
               }
           }
       }
       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='';
           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);
                       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 {
               &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);
     }      }
     &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'},      my @what=&Apache::lonnet::dump('critical',$env{'user.domain'},
Line 648  sub readmap { Line 826  sub readmap {
     return ($retfurl,$errtext);      return ($retfurl,$errtext);
 }  }
   
   sub build_tmp_hashes {
       my ($uri,$fn,$short,$cenvref) = @_;
       unless(ref($cenvref) eq 'HASH') {
           return;
       }
       my %cenv = %{$cenvref};
       my $gotstate = 0;
       %hash=();
       %parmhash=();
       $errtext='';
       $pc=0;
       &clear_mapalias_count();
       &processversionfile(%cenv);
       my $furi=&Apache::lonnet::clutter($uri);
       $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;
       &loadmap($uri,'0.0');
       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},'&');
           &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>");
           }
       }
       return $gotstate;
   }
   
   sub unlink_tmpfiles {
       my ($fn) = @_;
       if ($fn =~ m{^\Q$Apache::lonnet::perlvar{'lonUsersDir'}\E/tmp/}) {
           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 656  sub evalstate { Line 919  sub evalstate {
     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 $safeeval = new Safe;
  my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
Line 683  sub evalstate { Line 947  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;
 }  }
   
   {
       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 709  of course for user. Line 1010  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.95  
changed lines
  Added in v.1.135

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