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

Diff for /rat/lonuserstate.pm between versions 1.88 and 1.116

version 1.88, 2005/03/18 21:55:49 version 1.116, 2006/05/30 19:47:40
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 %encurl; # URLs in this folder are supposed to be encrypted  my %encurl; # URLs in this folder are supposed to be encrypted
Line 73  sub versiontrack { Line 77  sub versiontrack {
   
 sub putinversion {  sub putinversion {
     my $uri=shift;      my $uri=shift;
       my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri);
     if ($hash{'version_'.$uri}) {      if ($hash{'version_'.$uri}) {
  my $version=$hash{'version_'.$uri};   my $version=$hash{'version_'.$uri};
  if ($version eq 'mostrecent') { return $uri; }   if ($version eq 'mostrecent') { return $uri; }
Line 81  sub putinversion { Line 86  sub putinversion {
              { return $uri; }               { return $uri; }
  $uri=~s/\.(\w+)$/\.$version\.$1/;   $uri=~s/\.(\w+)$/\.$version\.$1/;
     }      }
       &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600);
     return $uri;      return $uri;
 }  }
   
Line 91  sub processversionfile { Line 97  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};
     }      }
 }  }
   
Line 101  sub processversionfile { Line 107  sub processversionfile {
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my $uri=shift;
     if ($hash{'map_pc_'.$uri}) { return OK; }      if ($hash{'map_pc_'.$uri}) { 
    $errtext.=&mt('<br />Multiple use of sequence/page <tt>[_1]</tt>! The course will not function properly.',$uri);
    return; 
       }
     $pc++;      $pc++;
     my $lpc=$pc;      my $lpc=$pc;
     $hash{'map_pc_'.$uri}=$lpc;      $hash{'map_pc_'.$uri}=$lpc;
Line 115  sub loadmap { Line 123  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);
Line 126  sub loadmap { Line 134  sub loadmap {
 # 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);
         my $token;          my $token;
   
         my $linkpc=0;          my $linkpc=0;
Line 138  sub loadmap { Line 147  sub loadmap {
     if ($token->[0] eq 'S') {      if ($token->[0] eq 'S') {
                 if ($token->[1] eq 'resource') {                  if ($token->[1] eq 'resource') {
 # -------------------------------------------------------------------- Resource  # -------------------------------------------------------------------- Resource
                       if ($token->[2]->{'type'} eq 'zombie') { next; }
                     my $rid=$lpc.'.'.$token->[2]->{'id'};                      my $rid=$lpc.'.'.$token->[2]->{'id'};
   
                     $hash{'kind_'.$rid}='res';                      $hash{'kind_'.$rid}='res';
Line 161  sub loadmap { Line 170  sub loadmap {
                         if ($token->[2]->{'external'} eq 'true') { # external                          if ($token->[2]->{'external'} eq 'true') { # external
                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;                              $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded                          } elsif ($turi=~/^\/*uploaded\//) { # uploaded
     if (($embstyle eq 'img') || ($embstyle eq 'emb')) {      if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
                                 $turi='/adm/wrapper'.$turi;                                  $turi='/adm/wrapper'.$turi;
     } elsif ($embstyle eq 'ssi') {      } elsif ($embstyle eq 'ssi') {
  #do nothing with these   #do nothing with these
Line 172  sub loadmap { Line 183  sub loadmap {
     my $mapdir=$uri;      my $mapdir=$uri;
     $mapdir=~s/[^\/]+$//;      $mapdir=~s/[^\/]+$//;
     $turi=&Apache::lonnet::hreflocation($mapdir,$turi);      $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
     if (($embstyle eq 'img') || ($embstyle eq 'emb')) {      if (($embstyle eq 'img') 
    || ($embstyle eq 'emb')
    || ($embstyle eq 'wrp')) {
  $turi='/adm/wrapper'.$turi;   $turi='/adm/wrapper'.$turi;
     }      }
                         }                          }
Line 270  sub loadmap { Line 283  sub loadmap {
     }      }
     $name=~s/^.*_([^_]*)$/$1/;      $name=~s/^.*_([^_]*)$/$1/;
                     my $newparam=                      my $newparam=
  &Apache::lonnet::escape($token->[2]->{'type'}).':'.   &escape($token->[2]->{'type'}).':'.
  &Apache::lonnet::escape($part.'.'.$name).'='.   &escape($part.'.'.$name).'='.
  &Apache::lonnet::escape($token->[2]->{'value'});   &escape($token->[2]->{'value'});
                     if (defined($hash{'param_'.$referid})) {                      if (defined($hash{'param_'.$referid})) {
                         $hash{'param_'.$referid}.='&'.$newparam;                          $hash{'param_'.$referid}.='&'.$newparam;
                     } else {                      } else {
Line 303  sub loadmap { Line 316  sub loadmap {
         }          }
   
     } else {      } else {
         $errtext.='Map not loaded: The file ('.$fn.') does not exist. ';          $errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn);
     }      }
 }  }
   
Line 311  sub loadmap { Line 324  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 338  sub traceroute { Line 353  sub traceroute {
  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});
  my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);   my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
  if ($hdnflag || lc($hidden) eq 'yes') { $hiddenurl{$rid}=1; }  
    if ($hdnflag || lc($hidden) eq 'yes') {
       $hiddenurl{$rid}=1;
    }
    if (!$hdnflag && lc($hidden) eq 'no') {
       delete($hiddenurl{$rid});
    }
   
  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 352  sub traceroute { Line 373  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=
Line 363  sub traceroute { Line 388  sub traceroute {
     }      }
  }   }
  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 390  sub accinit { Line 414  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 446  sub accinit { Line 466  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 476  sub hiddenurls { Line 496  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 529  sub hiddenurls { Line 549  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');      open(LOCKFILE,">$fn.db.lock");
     unlink($fn.'.state');      my $lock=0;
     unlink($fn.'parms.db');      if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) {
    $lock=1;
    unlink($fn.'.db');
    unlink($fn.'_symb.db');
    unlink($fn.'.state');
    unlink($fn.'parms.db');
       }
     undef %randompick;      undef %randompick;
     undef %hiddenurl;      undef %hiddenurl;
     undef %encurl;      undef %encurl;
     $retfurl='';      $retfrid='';
     if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&      if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
  (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {   (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
  %hash=();   %hash=();
  %parmhash=();   %parmhash=();
Line 564  sub readmap { Line 590  sub readmap {
     &Apache::lonnet::appenv("request.course.id"  => $short,      &Apache::lonnet::appenv("request.course.id"  => $short,
     "request.course.fn"  => $fn,      "request.course.fn"  => $fn,
     "request.course.uri" => $uri);      "request.course.uri" => $uri);
       $env{'request.course.id'}=$short;
     &traceroute('0',$hash{'map_start_'.$uri},'&');      &traceroute('0',$hash{'map_start_'.$uri},'&');
     &accinit($uri,$short,$fn);      &accinit($uri,$short,$fn);
     &hiddenurls();      &hiddenurls();
  }   }
 # ------------------------------------------------------- Put versions into src  # ------------------------------------------------------- Put versions into src
  foreach (keys %hash) {   foreach my $key (keys(%hash)) {
     if ($_=~/^src\_/) {      if ($key=~/^src_/) {
  $hash{$_}=&putinversion($hash{$_});   $hash{$key}=&putinversion($hash{$key});
       } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) {
    my ($type, $url) = ($1,$2);
    my $value = $hash{$key};
    $hash{$type.&putinversion($url)}=$value;
     }      }
  }   }
 # ---------------------------------------------------------------- Encrypt URLs  # ---------------------------------------------------------------- Encrypt URLs
  foreach (keys %encurl) {   foreach my $id (keys(%encurl)) {
 #    $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_});  #    $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id});
     $hash{'encrypted_'.$_}=1;      $hash{'encrypted_'.$id}=1;
  }   }
 # ----------------------------------------------- Close hashes to finally store  # ----------------------------------------------- Close hashes to finally store
 # --------------------------------- Routine must pass this point, no early outs  # --------------------------------- 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))) {   unless ((untie(%hash)) && (untie(%parmhash))) {
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".      &Apache::lonnet::logthis("<font color=blue>WARNING: ".
      "Could not untie coursemap $fn for $uri.</font>");        "Could not untie coursemap $fn for $uri.</font>"); 
Line 594  sub readmap { Line 634  sub readmap {
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  "Could not write statemap $fn for $uri.</font>");    "Could not write statemap $fn for $uri.</font>"); 
     }      }
  }     }
    flock(LOCKFILE,LOCK_UN);
    close(LOCKFILE);
     } else {      } 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
    if ($lock) {
       # Got the lock but not the DB files
       flock(LOCKFILE,LOCK_UN);
    }
  untie(%hash);   untie(%hash);
  untie(%parmhash);   untie(%parmhash);
  &Apache::lonnet::logthis("<font color=blue>WARNING: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
Line 609  sub readmap { Line 655  sub readmap {
  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) &&
    (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) {
  if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {   if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) {
     $retfurl='/adm/navmaps';      $retfurl='/adm/navmaps';
     &Apache::lonnet::appenv("request.course.id"  => $short,      &Apache::lonnet::appenv("request.course.id"  => $short,
Line 623  sub readmap { Line 670  sub readmap {
     untie(%hash);      untie(%hash);
     untie(%parmhash);      untie(%parmhash);
  }   }
    flock(LOCKFILE,LOCK_UN);
    close(LOCKFILE);
     }      }
     &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'},
    $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';
Line 640  sub readmap { Line 689  sub readmap {
 # ------------------------------------------------------- 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='';
     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 672  sub evalstate { Line 722  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;
 }  }
   
Removed from v.1.88  
changed lines
  Added in v.1.116

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.