Diff for /rat/lonuserstate.pm between versions 1.86 and 1.97

version 1.86, 2005/03/15 17:25:51 version 1.97, 2005/11/09 11:39:57
Line 32  package Apache::lonuserstate; Line 32  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::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 41  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 74  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 83  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 127  sub loadmap { Line 129  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 142  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 162  sub loadmap { Line 165  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 'ign')
    || ($embstyle eq 'unk')) {
                                 $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 339  sub traceroute { Line 345  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 (($retfurl eq '') && ($hash{'src_'.$rid})
Line 540  sub readmap { Line 553  sub readmap {
  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)) {
    $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='';      $retfurl='';
     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 582  sub readmap { Line 601  sub readmap {
  }   }
 # ----------------------------------------------- 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_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 589  sub readmap { Line 609  sub readmap {
 # ---------------------------------------------------- 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>"); 
     }      }
  }     }
    flock(LOCKFILE,LOCK_UN);
    close(LOCKFILE);
     } else {      } 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: ".   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  "Could not tie coursemap $fn for $uri.</font>");    "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);      &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 616  sub readmap { Line 670  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=();
Line 648  sub evalstate { Line 702  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.86  
changed lines
  Added in v.1.97


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