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

Diff for /rat/lonuserstate.pm between versions 1.79 and 1.99

version 1.79, 2004/10/26 15:10:42 version 1.99, 2006/01/10 21:41:29
Line 31  package Apache::lonuserstate; Line 31  package Apache::lonuserstate;
   
 # ------------------------------------------------- modules used by this module  # ------------------------------------------------- modules used by this module
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  
 use Apache::File;  
 use HTML::TokeParser;  use HTML::TokeParser;
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use GDBM_File;  use GDBM_File;
 use Apache::lonmsg;  use Apache::lonmsg;
Line 42  use Safe; Line 40  use Safe;
 use Safe::Hole;  use Safe::Hole;
 use Opcode;  use Opcode;
 use Apache::lonenc;  use Apache::lonenc;
   use Fcntl qw(:flock);
   
 # ---------------------------------------------------- Globals for this package  # ---------------------------------------------------- Globals for this package
   
Line 74  sub versiontrack { Line 73  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 82  sub putinversion { Line 82  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 102  sub processversionfile { Line 103  sub processversionfile {
   
 sub loadmap {   sub loadmap { 
     my $uri=shift;      my $uri=shift;
     if ($hash{'map_pc_'.$uri}) { return OK; }      if ($hash{'map_pc_'.$uri}) { return; }
   
     $pc++;      $pc++;
     my $lpc=$pc;      my $lpc=$pc;
Line 116  sub loadmap { Line 117  sub loadmap {
   
     unless (($fn=~/\.sequence$/) ||      unless (($fn=~/\.sequence$/) ||
             ($fn=~/\.page$/)) {               ($fn=~/\.page$/)) { 
        $errtext.="Invalid map: $fn\n";   $errtext.="Invalid map: $fn\n";
        return OK;    return; 
     }      }
   
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
Line 127  sub loadmap { Line 128  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 139  sub loadmap { Line 141  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 150  sub loadmap { Line 152  sub loadmap {
     $hash{'version_'.$turi}=$1;      $hash{'version_'.$turi}=$1;
  }   }
     }      }
     &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache,      my $title=$token->[2]->{'title'};
        &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'},      $title=~s/\&colon\;/\:/gs;
     $turi),  #    my $symb=&Apache::lonnet::encode_symb($uri,
       $token->[2]->{'title'},'title');  #  $token->[2]->{'id'},
   #  $turi);
   #    &Apache::lonnet::do_cache_new('title',$symb,$title);
                     unless ($ispage) {                      unless ($ispage) {
                         $turi=~/\.(\w+)$/;                          $turi=~/\.(\w+)$/;
                         my $embstyle=&Apache::loncommon::fileembstyle($1);                          my $embstyle=&Apache::loncommon::fileembstyle($1);
                         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 171  sub loadmap { Line 177  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 185  sub loadmap { Line 193  sub loadmap {
                         $hash{'ids_'.$idsuri}=''.$rid;                          $hash{'ids_'.$idsuri}=''.$rid;
                     }                      }
                                 
                     if                      if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
         ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {  
  $turi.='?register=1';   $turi.='?register=1';
     }      }
   
Line 298  sub loadmap { Line 305  sub loadmap {
  }   }
                     }                      }
                 }                   } 
   
             }              }
         }          }
   
     } else {      } else {
         $errtext.='Map not loaded: The file does not exist. ';          $errtext.='Map not loaded: The file ('.$fn.') does not exist. ';
     }      }
 }  }
   
 # --------------------------------------------------------- Simplify expression  # --------------------------------------------------------- Simplify expression
   
 sub simplify {  sub simplify {
    my $expression=shift;      my $expression=shift;
 # (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,$encflag,$hdnflag)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
     $sofar=simplify($sofar);      my $newsofar=$sofar=simplify($sofar);
     unless ($beenhere=~/\&$rid\&/) {      unless ($beenhere=~/\&$rid\&/) {
        $beenhere.=$rid.'&';     $beenhere.=$rid.'&';  
        my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
        my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});   my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid});
        my $encrypt=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);   my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb);
        if ($hdnflag || lc($encrypt) eq 'yes') { $hiddenurl{$rid}=1; }  
        my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);   if ($hdnflag || lc($hidden) eq 'yes') {
        if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }      $hiddenurl{$rid}=1;
        if (($retfurl eq '') && ($hash{'src_'.$rid})   }
    && ($hash{'src_'.$rid}!~/\.sequence$/)) {   if (!$hdnflag && lc($hidden) eq 'no') {
            $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').      delete($hiddenurl{$rid});
        'symb='.$symb;   }
        }  
        if (defined($hash{'conditions_'.$rid})) {   my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb);
    $hash{'conditions_'.$rid}=simplify(   if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; }
    if (($retfurl eq '') && ($hash{'src_'.$rid})
       && ($hash{'src_'.$rid}!~/\.sequence$/)) {
       $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').
    'symb='.$symb;
    }
    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})) {   $newsofar=$hash{'conditions_'.$rid};
            if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {   if (defined($hash{'is_map_'.$rid})) {
        &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&',      if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
    $encflag || $encurl{$rid},   $sofar=$newsofar=
    $hdnflag || $hiddenurl{$rid});      &traceroute($sofar,
                if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {   $hash{'map_start_'.$hash{'src_'.$rid}},'&',
    $sofar=   $encflag || $encurl{$rid},
                   $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};   $hdnflag || $hiddenurl{$rid});
                }      }
            }   }
        }   if (defined($hash{'to_'.$rid})) {
        if (defined($hash{'to_'.$rid})) {      foreach (split(/\,/,$hash{'to_'.$rid})) {
           foreach (split(/\,/,$hash{'to_'.$rid})) {  
  my $further=$sofar;   my $further=$sofar;
                 if ($hash{'undercond_'.$_}) {                  if ($hash{'undercond_'.$_}) {
    if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {      if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
         $further=simplify('('.$further.')&('.   $further=simplify('('.$further.')&('.
                               $hash{'condid_'.$hash{'undercond_'.$_}}.')');    $hash{'condid_'.$hash{'undercond_'.$_}}.')');
    } else {      } else {
                        $errtext.='Undefined condition ID: '   $errtext.='Undefined condition ID: '
                                  .$hash{'undercond_'.$_}.'. ';      .$hash{'undercond_'.$_}.'. ';
                    }      }
                 }                  }
                 &traceroute($further,$hash{'goesto_'.$_},$beenhere,$encflag,$hdnflag);                  $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere,
           }        $encflag,$hdnflag);
        }      }
    }
     }      }
       return $newsofar;
 }  }
   
 # ------------------------------ Cascading conditions, quick access, parameters  # ------------------------------ Cascading conditions, quick access, parameters
Line 390  sub accinit { Line 405  sub accinit {
     my $condcounter=0;      my $condcounter=0;
     $acchash{'acc.cond.'.$short.'.0'}=0;      $acchash{'acc.cond.'.$short.'.0'}=0;
     foreach (keys %hash) {      foreach (keys %hash) {
        if ($_=~/^conditions/) {   if ($_=~/^conditions/) {
   my $expr=$hash{$_};      my $expr=$hash{$_};
          foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) {      foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) {
              my $sub=$_;   my $sub=$_;
              my $orig=$_;   my $orig=$_;
       $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;   $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;
              my $factor=$1;   my $factor=$1;
              $sub=~s/$factor//g;   $sub=~s/$factor//g;
              $sub=~s/^\(/\($factor\(/;   $sub=~s/^\(/\($factor\(/;
      $sub.=')';   $sub.=')';
              $sub=simplify($sub);   $sub=simplify($sub);
              $orig=~s/(\W)/\\$1/g;   $orig=~s/(\W)/\\$1/g;
       $expr=~s/$orig/$sub/;   $expr=~s/$orig/$sub/;
   }      }
           $hash{$_}=$expr;      $hash{$_}=$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 ($_=~/^param_(\d+)\.(\d+)/) {
           my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}).      my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2,
       '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});      $hash{'src_'.$1.'.'.$2});
           foreach (split(/\&/,$hash{$_})) {      foreach (split(/\&/,$hash{$_})) {
      my ($typename,$value)=split(/\=/,$_);   my ($typename,$value)=split(/\=/,$_);
              my ($type,$name)=split(/\:/,$typename);   my ($type,$name)=split(/\:/,$typename);
              $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=   $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=
                                    &Apache::lonnet::unescape($value);      &Apache::lonnet::unescape($value);
      $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=   $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=
                                    &Apache::lonnet::unescape($type);      &Apache::lonnet::unescape($type);
           }      }
        }   }
     }      }
     foreach (keys %hash) {      foreach (keys %hash) {
  if ($_=~/^ids/) {   if ($_=~/^ids/) {
   foreach (split(/\,/,$hash{$_})) {      foreach (split(/\,/,$hash{$_})) {
     my $resid=$_;   my $resid=$_;
             my $uri=$hash{'src_'.$resid};   my $uri=$hash{'src_'.$resid};
             $uri=~s/^\/adm\/wrapper//;   $uri=~s/^\/adm\/wrapper//;
             $uri=&Apache::lonnet::declutter($uri);   $uri=&Apache::lonnet::declutter($uri);
             my @uriparts=split(/\//,$uri);   my @uriparts=split(/\//,$uri);
             my $urifile=$uriparts[$#uriparts];   my $urifile=$uriparts[$#uriparts];
             $#uriparts--;   $#uriparts--;
             my $uripath=join('/',@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})) {
   $uricond=$captured{$hash{'conditions_'.$resid}};   $uricond=$captured{$hash{'conditions_'.$resid}};
             }      }
             if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {      if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
                 if ($acchash{'acc.res.'.$short.'.'.$uripath}=~   if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
                    /(\&\Q$urifile\E\:[^\&]*)/) {      /(\&\Q$urifile\E\:[^\&]*)/) {
     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.'&';
         }   }
             } else {      } else {
                 $acchash{'acc.res.'.$short.'.'.$uripath}=   $acchash{'acc.res.'.$short.'.'.$uripath}=
                  '&'.$urifile.':'.$uricond.'&';      '&'.$urifile.':'.$uricond.'&';
             }      }
            }    } 
          }      }
       }   }
     }      }
     $acchash{'acc.res.'.$short.'.'}='&:0&';      $acchash{'acc.res.'.$short.'.'}='&:0&';
     my $courseuri=$uri;      my $courseuri=$uri;
Line 502  sub hiddenurls { Line 517  sub hiddenurls {
  $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]})   ).'&';
                  ).'&';  
             }              }
         }          }
     }      }
Line 515  sub hiddenurls { Line 529  sub hiddenurls {
  $hash{'randomout_'.$rid}=1;   $hash{'randomout_'.$rid}=1;
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
  $randomoutentry.='&'.   $randomoutentry.='&'.
     &Apache::lonnet::symbclean(      &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,
          &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).   $hash{'src_'.$rid}).'&';
        '___'.$resid.'___'.  
     &Apache::lonnet::declutter($hash{'src_'.$rid})  
        ).'&';  
     }      }
 # --------------------------------------- append randomout entry to environment  # --------------------------------------- append randomout entry to environment
     if ($randomoutentry) {      if ($randomoutentry) {
Line 530  sub hiddenurls { Line 541  sub hiddenurls {
 # ---------------------------------------------------- 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);
    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 '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;
    undef %hiddenurl;   unlink($fn.'.db');
    undef %encurl;   unlink($fn.'_symb.db');
    $retfurl='';   unlink($fn.'.state');
    if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&   unlink($fn.'parms.db');
        (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {      }
     %hash=();      undef %randompick;
     %parmhash=();      undef %hiddenurl;
     $errtext='';      undef %encurl;
     $pc=0;      $retfurl='';
     &processversionfile(%cenv);      if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
     my $furi=&Apache::lonnet::clutter($uri);   (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
     $hash{'src_0.0'}=&versiontrack($furi);   %hash=();
     $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');   %parmhash=();
     $hash{'ids_'.$furi}='0.0';   $errtext='';
     $hash{'is_map_0.0'}=1;   $pc=0;
     loadmap($uri);   &processversionfile(%cenv);
     if (defined($hash{'map_start_'.$uri})) {   my $furi=&Apache::lonnet::clutter($uri);
  &Apache::lonnet::appenv("request.course.id"  => $short,   $hash{'src_0.0'}=&versiontrack($furi);
  "request.course.fn"  => $fn,   $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
  "request.course.uri" => $uri);   $hash{'ids_'.$furi}='0.0';
         &traceroute('0',$hash{'map_start_'.$uri},'&');   $hash{'is_map_0.0'}=1;
         &accinit($uri,$short,$fn);   loadmap($uri);
         &hiddenurls();   if (defined($hash{'map_start_'.$uri})) {
     }      &Apache::lonnet::appenv("request.course.id"  => $short,
       "request.course.fn"  => $fn,
       "request.course.uri" => $uri);
       &traceroute('0',$hash{'map_start_'.$uri},'&');
       &accinit($uri,$short,$fn);
       &hiddenurls();
    }
 # ------------------------------------------------------- Put versions into src  # ------------------------------------------------------- Put versions into src
     foreach (keys %hash) {   foreach (keys %hash) {
  if ($_=~/^src\_/) {      if ($_=~/^src\_/) {
     $hash{$_}=&putinversion($hash{$_});   $hash{$_}=&putinversion($hash{$_});
       }
  }   }
     }  
 # ---------------------------------------------------------------- Encrypt URLs  # ---------------------------------------------------------------- Encrypt URLs
     foreach (keys %encurl) {   foreach (keys %encurl) {
  $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_});  #    $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_});
     }      $hash{'encrypted_'.$_}=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
     unless ((untie(%hash)) && (untie(%parmhash))) {   $hash{'first_url'}=$retfurl;
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".   unless ((untie(%hash)) && (untie(%parmhash))) {
                        "Could not untie coursemap $fn for $uri.</font>");       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
     }       "Could not untie coursemap $fn for $uri.</font>"); 
    }
 # ---------------------------------------------------- Store away initial state  # ---------------------------------------------------- Store away initial state
     {   {
      my $cfh;      my $cfh;
      if ($cfh=Apache::File->new(">$fn.state")) {      if (open($cfh,">$fn.state")) {
         print $cfh join("\n",@cond);   print $cfh join("\n",@cond);
      } else {      } else {
       &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>"); 
      }      }
     }     }
    } else {   flock(LOCKFILE,LOCK_UN);
       &Apache::lonnet::logthis("<font color=blue>WARNING: ".   close(LOCKFILE);
                        "Could not tie coursemap $fn for $uri.</font>");       } else {
    }   # if we are here it is likely because we are already trying to 
    &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);   # 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);      my $fh=Apache::File->new($fn);
         @conditions=<$fh>;      @conditions=<$fh>;
        }     }  
        my $safeeval = new Safe;   my $safeeval = new Safe;
        my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
        $safeeval->permit("entereval");   $safeeval->permit("entereval");
        $safeeval->permit(":base_math");   $safeeval->permit(":base_math");
        $safeeval->deny(":base_io");   $safeeval->deny(":base_io");
        $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
        foreach (@conditions) {   foreach my $line (@conditions) {
    my $line=$_;      chomp($line);
            chomp($line);      my ($condition,$weight)=split(/\:/,$line);
    my ($condition,$weight)=split(/\:/,$_);      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;
 }  }
   
Removed from v.1.79  
changed lines
  Added in v.1.99

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.