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

version 1.97, 2005/11/09 11:39:57 version 1.105, 2006/02/23 18:17:37
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::loncommon();  use Apache::loncommon();
Line 104  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 119  sub loadmap { Line 118  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 167  sub loadmap { Line 166  sub loadmap {
                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded                          } elsif ($turi=~/^\/*uploaded\//) { # uploaded
     if (($embstyle eq 'img')       if (($embstyle eq 'img') 
  || ($embstyle eq 'emb')   || ($embstyle eq 'emb')
  || ($embstyle eq 'ign')   || ($embstyle eq 'wrp')) {
  || ($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 179  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 318  sub loadmap { Line 318  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 366  sub traceroute { Line 368  sub traceroute {
  } else {   } else {
     $hash{'conditions_'.$rid}=$sofar;      $hash{'conditions_'.$rid}=$sofar;
  }   }
  $newsofar=$hash{'conditions_'.$rid};   $newsofar='_'.$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 381  sub traceroute { Line 383  sub traceroute {
  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('('.'_'.$rid.')&('.
   $hash{'condid_'.$hash{'undercond_'.$_}}.')');    $hash{'condid_'.$hash{'undercond_'.$_}}.')');
     } else {      } else {
  $errtext.='Undefined condition ID: '   $errtext.='Undefined condition ID: '
Line 404  sub accinit { Line 406  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) {      foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) {
  my $sub=$_;   my $orig=$sub;
  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\(/;
Line 419  sub accinit { Line 420  sub accinit {
  $orig=~s/(\W)/\\$1/g;   $orig=~s/(\W)/\\$1/g;
  $expr=~s/$orig/$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.'.'.&Apache::lonnet::unescape($name)}=
     &Apache::lonnet::unescape($value);      &Apache::lonnet::unescape($value);
Line 438  sub accinit { Line 439  sub accinit {
     }      }
  }   }
     }      }
     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 460  sub accinit { Line 456  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.'&';

Removed from v.1.97  
changed lines
  Added in v.1.105


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