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

Diff for /rat/lonuserstate.pm between versions 1.122 and 1.132

version 1.122, 2007/08/28 01:13:19 version 1.132, 2009/11/15 14:08:53
Line 56  my $retfrid; # variable with the very fi Line 56  my $retfrid; # variable with the very fi
 my $retfurl; # first URL  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
   
Line 106  sub processversionfile { Line 107  sub processversionfile {
 # --------------------------------------------------------- Loads map from disk  # --------------------------------------------------------- Loads map from disk
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my ($uri,$parent_rid)=@_;
     if ($hash{'map_pc_'.$uri}) {       if ($hash{'map_pc_'.$uri}) { 
  $errtext.='<p class="LC_error">'.   $errtext.='<p class="LC_error">'.
     &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').      &mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>').
Line 131  sub loadmap { Line 132  sub loadmap {
   
     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') {
         $fn=~/\.(\w+)$/;      &parse_param($token,$lpc);
    } 
         $hash{'map_type_'.$lpc}=$1;      }
       #reset parser
         while ($token = $parser->get_token) {      $parser = HTML::TokeParser->new(\$instr);
     if ($token->[0] eq 'S') {      $parser->attr_encoded(1);
                 if ($token->[1] eq 'resource') {  
 # -------------------------------------------------------------------- Resource  
                     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/^http\:\/\//\/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') {      my $linkpc=0;
                         $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$/) ||      $fn=~/\.(\w+)$/;
                         ($turi=~/\.page$/)) {  
                         $hash{'is_map_'.$rid}=1;  
                         &loadmap($turi);  
                     }   
                       
                 } elsif ($token->[1] eq 'condition') {  
 # ------------------------------------------------------------------- Condition  
   
                     my $rid=$lpc.'.'.$token->[2]->{'id'};      $hash{'map_type_'.$lpc}=$1;
   
                     $hash{'kind_'.$rid}='cond';      my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i);
                     $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') {      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  # ----------------------------------------------------------------------- Links
       &make_link(++$linkpc,$lpc,$token->[2]->{'to'},
          $token->[2]->{'from'},
          $token->[2]->{'condition'});
    } elsif ($token->[1] eq 'condition' && !$randomize) {
       &parse_condition($token,$lpc);
    }
       }
   
                     $linkpc++;      if ($randomize) {
                     my $linkid=$lpc.'.'.$linkpc;   if (!$env{'request.role.adv'}) {
       my $seed;
                     my $goesto=$lpc.'.'.$token->[2]->{'to'};      if (defined($randompickseed{$parent_rid})) {
                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};   $seed = $randompickseed{$parent_rid};
                     my $undercond=0;      } else {
    my ($mapid,$resid)=split(/\./,$parent_rid);
                     if ($token->[2]->{'condition'}) {   my $symb=
  $undercond=$lpc.'.'.$token->[2]->{'condition'};      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},
                     }   $resid,$hash{'src_'.$parent_rid});
   
                     $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  
   
                     my $referid=$lpc.'.'.$token->[2]->{'to'};  
     my $name=$token->[2]->{'name'};  
     my $part;  
     if ($name=~/^parameter_(.*)_/) {  
  $part=$1;  
     } else {  
  $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_)*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;  
  }  
                     }  
                 }   
   
             }   $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';
   
     } else {   while (my $to = shift(@map_ids)) {
         $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);      &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';
     }      }
   
     my $parser = HTML::TokeParser->new(\$instr);      $parser = HTML::TokeParser->new(\$instr);
     $parser->attr_encoded(1);      $parser->attr_encoded(1);
     # last parse out the mapalias params so as to ignore anything      # last parse out the mapalias params so as to ignore anything
     # refering to non-existant resources      # refering to non-existant resources
Line 330  sub loadmap { Line 222  sub loadmap {
     }      }
 }  }
   
   
   # -------------------------------------------------------------------- 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'};
   }
   
   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 (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;
       }
   }
   
   # ------------------------------------------------------------------- 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';
       }
   }
   
   # ------------------------------------------------------------------- Parameter
   
   sub parse_param {
       my ($token,$lpc) = @_;
       my $referid=$lpc.'.'.$token->[2]->{'to'};
       my $name=$token->[2]->{'name'};
       my $part;
       if ($name=~/^parameter_(.*)_/) {
    $part=$1;
       } else {
    $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 {  sub parse_mapalias_param {
     my ($token,$lpc) = @_;      my ($token,$lpc) = @_;
     my $referid=$lpc.'.'.$token->[2]->{'to'};      my $referid=$lpc.'.'.$token->[2]->{'to'};
Line 403  sub traceroute { Line 471  sub traceroute {
     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});
     }      }
Line 504  sub accinit { Line 573  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 561  sub hiddenurls { Line 631  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 583  sub readmap { Line 653  sub readmap {
   
     open(LOCKFILE,">$fn.db.lock");      open(LOCKFILE,">$fn.db.lock");
     my $lock=0;      my $lock=0;
       my $gotstate=0;
     if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
  $lock=1;   $lock=1;
  unlink($fn.'.db');          &unlink_tmpfiles($fn);
  unlink($fn.'_symb.db');  
  unlink($fn.'.state');  
  unlink($fn.'parms.db');  
     }      }
     undef %randompick;      undef %randompick;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
     $retfrid='';      $retfrid='';
     if ($lock && (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;
  &clear_mapalias_count();                  $gotstate = &build_tmp_hashes($uri,$fn,$short,\%cenv);
  &processversionfile(%cenv);                  unless ($gotstate) {
  my $furi=&Apache::lonnet::clutter($uri);                      &Apache::lonnet::logthis('Failed to write statemap at first attempt '.$fn.' for '.$uri.'.</font>');
  $hash{'src_0.0'}=&versiontrack($furi);                  }
  $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');                  $untiedparmhash = untie(%parmhash);
  $hash{'ids_'.$furi}='0.0';                  unless ($untiedparmhash) {
  $hash{'is_map_0.0'}=1;                      &Apache::lonnet::logthis('<font color="blue">WARNING: '.
  loadmap($uri);                          'Could not untie coursemap parmhash '.$fn.' for '.$uri.'.</font>');
  if (defined($hash{'map_start_'.$uri})) {                  }
     &Apache::lonnet::appenv("request.course.id"  => $short,              }
     "request.course.fn"  => $fn,              $untiedhash = untie(%hash);
     "request.course.uri" => $uri);              unless ($untiedhash) {
     $env{'request.course.id'}=$short;                  &Apache::lonnet::logthis('<font color="blue">WARNING: '.
     &traceroute('0',$hash{'map_start_'.$uri},'&');                      'Could not untie coursemap hash '.$fn.' for '.$uri.'.</font>');
     &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;  
  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);   flock(LOCKFILE,LOCK_UN);
  close(LOCKFILE);   close(LOCKFILE);
     } else {      }
       unless ($lock && $tiedhash && $tiedparmhash) { 
  # 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 
Line 669  sub readmap { Line 696  sub readmap {
  if ($lock) {   if ($lock) {
     # Got the lock but not the DB files      # Got the lock but not the DB files
     flock(LOCKFILE,LOCK_UN);      flock(LOCKFILE,LOCK_UN);
               $lock = 0;
  }   }
  untie(%hash);          if ($tiedhash) {
  untie(%parmhash);              unless($untiedhash) {
           untie(%hash);
               }
           }
           if ($tiedparmhash) {
               unless($untiedparmhash) {
                   untie(%parmhash);
               }
           }
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  "Could not tie coursemap $fn for $uri.</font>");    "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 (flock(LOCKFILE,LOCK_EX|LOCK_NB) &&      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
  (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {                  $lock = 1;
  if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {   if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
     $retfurl='/adm/navmaps';                      $tiedhash = 1;
     &Apache::lonnet::appenv("request.course.id"  => $short,      if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
     "request.course.fn"  => $fn,                          $tiedparmhash = 1;
     "request.course.uri" => $uri);                          if (-e "$fn.state") {
     untie(%hash);              $retfurl='/adm/navmaps';
     untie(%parmhash);              &Apache::lonnet::appenv({"request.course.id"  => $short,
     last;                 "request.course.fn"  => $fn,
  }               "request.course.uri" => $uri});
     }              $untiedhash = untie(%hash);
     untie(%hash);              $untiedparmhash = untie(%parmhash);
     untie(%parmhash);                              $gotstate = 1;
               last;
           }
                           $untiedparmhash = untie(%parmhash);
               }
               $untiedhash = untie(%hash);
                   }
               }
  }   }
  flock(LOCKFILE,LOCK_UN);          if ($lock) {
  close(LOCKFILE);              flock(LOCKFILE,LOCK_UN);
               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) {
           &Apache::lonnet::logthis('<font color="blue">WARNING: '.
                        'Could not read statemap '.$fn.' for '.$uri.'.</font>');
           &unlink_tmpfiles($fn);
           if (open(LOCKFILE,">$fn.db.lock")) {
               my $lock=0;
               if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
                   $lock=1;
                   &unlink_tmpfiles($fn);
               }
               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);
                  close(LOCKFILE);
               } 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 709  sub readmap { Line 817  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 745  sub evalstate { Line 938  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;
 }  }
   
Line 769  sub evalstate { Line 962  sub evalstate {
      $count++;       $count++;
  }   }
  my ($mapid) = split(/\./,$id);   my ($mapid) = split(/\./,$id);
                          &mt('[_1] in [_2]', $hash{'title_'.$id},                           &mt('Resource "[_1]" <br /> in Map "[_2]"',
        $hash{'title_'.$id},
      $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});       $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}});
      } (@{ $mapalias_cache{$mapalias} }));       } (@{ $mapalias_cache{$mapalias} }));
     next if ($count < 2);      next if ($count < 2);
Line 808  of course for user. Line 1001  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.122  
changed lines
  Added in v.1.132

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