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

Diff for /rat/lonuserstate.pm between versions 1.85 and 1.96

version 1.85, 2005/03/15 17:21:42 version 1.96, 2005/09/23 21:39:09
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 339  sub traceroute { Line 342  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 413  sub accinit { Line 423  sub accinit {
  $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);
Line 504  sub hiddenurls { Line 514  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 517  sub hiddenurls { Line 526  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 544  sub readmap { Line 550  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 586  sub readmap { Line 598  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 593  sub readmap { Line 606  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 620  sub readmap { Line 667  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 652  sub evalstate { Line 699  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.85  
changed lines
  Added in v.1.96

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