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

Diff for /rat/lonuserstate.pm between versions 1.50 and 1.131

version 1.50, 2003/02/21 23:01:48 version 1.131, 2009/02/18 07:06:19
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # (Server for RAT Maps  
 #  
 # (Edit Handler for RAT Maps  
 # (TeX Content Handler  
 #  
 # YEAR=2000  
 # 05/29/00,05/30 Gerd Kortemeyer)  
 # 7/1 Gerd Kortemeyer)  
 # 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)  
 #  
 # 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,  
 # 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31,  
 # 11/1,11/2,11/14,11/16,11/22,12/28,  
 # YEAR=2001  
 # 07/05/01,08/30,08/31 Gerd Kortemeyer  
 #  
 ###  ###
   
 package Apache::lonuserstate;  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;
    
   
 # ---------------------------------------------------- Globals for this package  # ---------------------------------------------------- Globals for this package
   
Line 65  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 %actualversion; # version of resource as loaded now  my %randompickseed; # optional seed for randomly picking resources
 my %setversion; # forced version of resource  my %randomorder; # maps to order contents randomly
 my %lastversion; # version when CC came in last  my %encurl; # URLs in this folder are supposed to be encrypted
 my $versionmode; # how versioning is handled in this course  my %hiddenurl; # this URL (or complete folder) is supposed to be hidden
   
 # --------------------------------------------------------- Loads map from disk  # ----------------------------------- Remove version from URL and store in hash
   
 sub loadmap {   sub versiontrack {
       my $uri=shift;
       if ($uri=~/\.(\d+)\.\w+$/) {
    my $version=$1;
    $uri=~s/\.\d+\.(\w+)$/\.$1/;
           unless ($hash{'version_'.$uri}) {
       $hash{'version_'.$uri}=$version;
    }
       }
       return $uri;
   }
   
   # -------------------------------------------------------------- Put in version
   
   sub putinversion {
     my $uri=shift;      my $uri=shift;
     if ($hash{'map_pc_'.$uri}) { return OK; }      my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri);
       if ($hash{'version_'.$uri}) {
    my $version=$hash{'version_'.$uri};
    if ($version eq 'mostrecent') { return $uri; }
    if ($version eq &Apache::lonnet::getversion(
    &Apache::lonnet::filelocation('',$uri))) 
                { return $uri; }
    $uri=~s/\.(\w+)$/\.$version\.$1/;
       }
       &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
       return $uri;
   }
   
   # ----------------------------------------- Processing versions file for course
   
   sub processversionfile {
       my %cenv=@_;
       my %versions=&Apache::lonnet::dump('resourceversions',
          $cenv{'domain'},
          $cenv{'num'});
       foreach my $ver (keys(%versions)) {
    if ($ver=~/^error\:/) { return; }
    $hash{'version_'.$ver}=$versions{$ver};
       }
   }
   
   # --------------------------------------------------------- Loads map from disk
   
   sub loadmap { 
       my ($uri,$parent_rid)=@_;
       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;
     $hash{'map_id_'.$lpc}=$uri;      $hash{'map_id_'.$lpc}=$uri;
   
 # Determine and check filename  # Determine and check filename
     my $fn=&Apache::lonnet::filelocation('',$uri);      my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));
   
     my $ispage=($fn=~/\.page$/);      my $ispage=($fn=~/\.page$/);
   
     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 == -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);
         my $token;      $parser->attr_encoded(1);
       # first get all parameters
         my $linkpc=0;      while (my $token = $parser->get_token) {
    next if ($token->[0] ne 'S');
         $fn=~/\.(\w+)$/;   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);
    }
       }
   
       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
   sub parse_resource {
       my ($token,$lpc,$ispage,$uri) = @_;
       if ($token->[2]->{'type'} eq 'zombie') { next; }
       my $rid=$lpc.'.'.$token->[2]->{'id'};
       
       $hash{'kind_'.$rid}='res';
       $hash{'title_'.$rid}=$token->[2]->{'title'};
       my $turi=&versiontrack($token->[2]->{'src'});
       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,
   #  $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)$/) {
    $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'};
   }
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};  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;
   
                     $hash{'kind_'.$rid}='res';      if (defined($hash{'to_'.$comesfrom})) {
                     $hash{'title_'.$rid}=$token->[2]->{'title'};   $hash{'to_'.$comesfrom}.=','.$linkid;
                     my $turi=$token->[2]->{'src'};      } else {
                     $Apache::lonnet::titlecache{   $hash{'to_'.$comesfrom}=''.$linkid;
      &Apache::lonnet::symbclean(      }
                       &Apache::lonnet::declutter($uri).'___'.      if (defined($hash{'from_'.$goesto})) {
                       $token->[2]->{'id'}.'___'.   $hash{'from_'.$goesto}.=','.$linkid;
       &Apache::lonnet::declutter($turi))}=      } else {
                           $token->[2]->{'title'};   $hash{'from_'.$goesto}=''.$linkid;
                     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;  
                             }  
                         } else { # normal internal resource  
                            if (($embstyle eq 'img') || ($embstyle eq 'emb')  
              || ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/)) {  
        $turi='/adm/wrapper'.$turi;  
                            }  
                         }  
     }  
                     $hash{'src_'.$rid}=$turi;  
   
                     if (defined($hash{'ids_'.$turi})) {  
                         $hash{'ids_'.$turi}.=','.$rid;  
                     } else {  
                         $hash{'ids_'.$turi}=''.$rid;  
                     }  
   
                     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);  
                     }   
                       
                 } 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 $part=$token->[2]->{'part'};      my ($token,$lpc) = @_;
                     unless ($part) { $part=0; }      my $referid=$lpc.'.'.$token->[2]->{'to'};
                     my $newparam=      my $name=$token->[2]->{'name'};
  &Apache::lonnet::escape($token->[2]->{'type'}).':'.      my $part;
  &Apache::lonnet::escape($part.'.'.      if ($name=~/^parameter_(.*)_/) {
                          $token->[2]->{'name'}).'='.   $part=$1;
  &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'};  
                     }  
                 }   
   
             }  
         }  
   
     } else {      } else {
         $errtext.='Map not loaded: The file 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;
     }      }
 }  }
   
 # --------------------------------------------------------- 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 328  sub accinit { Line 504  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) =
             my @uriparts=split(/\//,$uri);      &Apache::lonnet::split_uri_for_cond($uri);
             my $urifile=$uriparts[$#uriparts];   if ($uripath) {
             $#uriparts--;      my $uricond='0';
             my $uripath=join('/',@uriparts);      if (defined($hash{'conditions_'.$resid})) {
             $uripath=~s/^\/res\///;   $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;
                    /(\&$urifile\:[^\&]*)/) {      $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 432  sub pickrandom { Line 602  sub pickrandom {
         next if ($#currentrids<$rndpick);          next if ($#currentrids<$rndpick);
 # -------------------------------- randomly eliminate the ones that should stay  # -------------------------------- randomly eliminate the ones that should stay
  my (undef,$id)=split(/\./,$rid);   my (undef,$id)=split(/\./,$rid);
           if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }
  my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb   my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb
  &Math::Random::random_set_seed_from_phrase($rndseed);   &Apache::lonnet::setup_random_from_rndseed($rndseed);
  my @whichids=&Math::Random::random_permuted_index($#currentrids+1);   my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
         for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }          for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
  #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids));   #&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids));
Line 443  sub pickrandom { Line 614  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 %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');      open(LOCKFILE,">$fn.db.lock");
    unlink($fn.'.state');      my $lock=0;
    unlink($fn.'parms.db');      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
    undef %randompick;   $lock=1;
    $retfurl='';   unlink($fn.'.db');
    if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&   unlink($fn.'_symb.db');
        (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {   unlink($fn.'.state');
     %hash=();   unlink($fn.'parms.db');
     %parmhash=();      }
     $errtext='';      undef %randompick;
     $pc=0;      undef %hiddenurl;
     my $furi=&Apache::lonnet::clutter($uri);      undef %encurl;
     $hash{'src_0.0'}=$furi;      $retfrid='';
     $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');      if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
     $hash{'ids_'.$furi}='0.0';   (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
     $hash{'is_map_0.0'}=1;   %hash=();
     loadmap($uri);   %parmhash=();
     if (defined($hash{'map_start_'.$uri})) {   $errtext='';
         &traceroute('0',$hash{'map_start_'.$uri},'&');   $pc=0;
         &accinit($uri,$short,$fn);   &clear_mapalias_count();
         &pickrandom();   &processversionfile(%cenv);
     }   my $furi=&Apache::lonnet::clutter($uri);
 # ------------------------------------------------------------ Version tracking   $hash{'src_0.0'}=&versiontrack($furi);
 #    if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {   $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
 # &Apache::lonnet::logthis('Will be version tracking');   $hash{'ids_'.$furi}='0.0';
 #    }   $hash{'is_map_0.0'}=1;
     unless ((untie(%hash)) && (untie(%parmhash))) {   loadmap($uri,'0.0');
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".   if (defined($hash{'map_start_'.$uri})) {
                        "Could not untie coursemap $fn for $uri.</font>");       &Apache::lonnet::appenv({"request.course.id"  => $short,
     }       "request.course.fn"  => $fn,
     {       "request.course.uri" => $uri});
      my $cfh;      $env{'request.course.id'}=$short;
      if ($cfh=Apache::File->new(">$fn.state")) {      &traceroute('0',$hash{'map_start_'.$uri},'&');
         print $cfh join("\n",@cond);      &accinit($uri,$short,$fn);
      } else {      &hiddenurls();
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".   }
                        "Could not write statemap $fn for $uri.</font>");    $errtext .= &get_mapalias_errors();
      }  # ------------------------------------------------------- Put versions into src
     }     foreach my $key (keys(%hash)) {
    } else {      if ($key=~/^src_/) {
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".   $hash{$key}=&putinversion($hash{$key});
                        "Could not tie coursemap $fn for $uri.</font>");       } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {
    }   my ($type, $url) = ($1,$2);
    &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);   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;
    unless ((untie(%hash)) && (untie(%parmhash))) {
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
        "Could not untie coursemap $fn for $uri.</font>"); 
    }
   # ---------------------------------------------------- Store away initial state
    {
       my $cfh;
       if (open($cfh,">$fn.state")) {
    print $cfh join("\n",@cond);
       } else {
    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
    "Could not write statemap $fn for $uri.</font>"); 
       }
    }
    flock(LOCKFILE,LOCK_UN);
    close(LOCKFILE);
       } else {
    # if we are here it is likely because we are already trying to 
    # 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
    if ($lock) {
       # Got the lock but not the DB files
       flock(LOCKFILE,LOCK_UN);
    }
    untie(%hash);
    untie(%parmhash);
    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
    "Could not tie coursemap $fn for $uri.</font>"); 
    my $i=0;
    while($i<90) {
       $i++;
       sleep(1);
       if (flock(LOCKFILE,LOCK_EX|LOCK_NB) &&
    (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {
    if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
       $retfurl='/adm/navmaps';
       &Apache::lonnet::appenv({"request.course.id"  => $short,
        "request.course.fn"  => $fn,
        "request.course.uri" => $uri});
       untie(%hash);
       untie(%parmhash);
       last;
    }
       }
       untie(%hash);
       untie(%parmhash);
    }
    flock(LOCKFILE,LOCK_UN);
    close(LOCKFILE);
       }
       &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'},
                                               $ENV{'user.name'});     $env{'user.name'});
     if ($what[0]) {      if ($what[0]) {
  if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {   if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
     $retfurl='/adm/email?critical=display';      $retfurl='/adm/email?critical=display';
         }          }
     }      }
    return ($retfurl,$errtext);      return ($retfurl,$errtext);
 }  }
   
 # ------------------------------------------------------- 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;
 }  }
   
   {
       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 591  of course for user. Line 878  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.50  
changed lines
  Added in v.1.131

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