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

version 1.84, 2005/02/17 09:09:11 version 1.85, 2005/03/15 17:21:42
Line 116  sub loadmap { Line 116  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 OK; 
     }      }
   
     my $instr=&Apache::lonnet::getfile($fn);      my $instr=&Apache::lonnet::getfile($fn);
Line 187  sub loadmap { Line 187  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 300  sub loadmap { Line 299  sub loadmap {
  }   }
                     }                      }
                 }                   } 
   
             }              }
         }          }
   
Line 312  sub loadmap { Line 311  sub loadmap {
 # --------------------------------------------------------- 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
Line 336  sub traceroute { Line 335  sub traceroute {
     my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;      my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_;
     my $newsofar=$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 $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; }
        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})
    && ($hash{'src_'.$rid}!~/\.sequence$/)) {      && ($hash{'src_'.$rid}!~/\.sequence$/)) {
            $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').      $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?').
        'symb='.$symb;   'symb='.$symb;
        }   }
        if (defined($hash{'conditions_'.$rid})) {   if (defined($hash{'conditions_'.$rid})) {
    $hash{'conditions_'.$rid}=simplify(      $hash{'conditions_'.$rid}=simplify(
            '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');             '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
        } else {   } else {
            $hash{'conditions_'.$rid}=$sofar;      $hash{'conditions_'.$rid}=$sofar;
        }   }
        $newsofar=$hash{'conditions_'.$rid};   $newsofar=$hash{'conditions_'.$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=
    &traceroute($sofar,      &traceroute($sofar,
        $hash{'map_start_'.$hash{'src_'.$rid}},'&',   $hash{'map_start_'.$hash{'src_'.$rid}},'&',
        $encflag || $encurl{$rid},   $encflag || $encurl{$rid},
        $hdnflag || $hiddenurl{$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_'.$_}.'. ';
                    }      }
                 }                  }
                 $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere,                  $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere,
       $encflag,$hdnflag);        $encflag,$hdnflag);
           }      }
        }   }
     }      }
     return $newsofar;      return $newsofar;
 }  }
Line 393  sub accinit { Line 392  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::declutter($hash{'map_id_'.$1}).
       '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});   '___'.$2.'___'.&Apache::lonnet::declutter($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 505  sub hiddenurls { Line 504  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::symbclean(
     &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).         &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
                     '___'.$resid.'___'.         '___'.$resid.'___'.
     &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})         &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})
                  ).'&';         ).'&';
             }              }
         }          }
     }      }
Line 519  sub hiddenurls { Line 518  sub hiddenurls {
  my ($mapid,$resid)=split(/\./,$rid);   my ($mapid,$resid)=split(/\./,$rid);
  $randomoutentry.='&'.   $randomoutentry.='&'.
     &Apache::lonnet::symbclean(      &Apache::lonnet::symbclean(
          &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).         &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
        '___'.$resid.'___'.         '___'.$resid.'___'.
     &Apache::lonnet::declutter($hash{'src_'.$rid})         &Apache::lonnet::declutter($hash{'src_'.$rid})
        ).'&';         ).'&';
     }      }
 # --------------------------------------- append randomout entry to environment  # --------------------------------------- append randomout entry to environment
Line 533  sub hiddenurls { Line 532  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.'.db');
    unlink($fn.'_symb.db');      unlink($fn.'_symb.db');
    unlink($fn.'.state');      unlink($fn.'.state');
    unlink($fn.'parms.db');      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 ((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=();
     $errtext='';   $errtext='';
     $pc=0;   $pc=0;
     &processversionfile(%cenv);   &processversionfile(%cenv);
     my $furi=&Apache::lonnet::clutter($uri);   my $furi=&Apache::lonnet::clutter($uri);
     $hash{'src_0.0'}=&versiontrack($furi);   $hash{'src_0.0'}=&versiontrack($furi);
     $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');   $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
     $hash{'ids_'.$furi}='0.0';   $hash{'ids_'.$furi}='0.0';
     $hash{'is_map_0.0'}=1;   $hash{'is_map_0.0'}=1;
     loadmap($uri);   loadmap($uri);
     if (defined($hash{'map_start_'.$uri})) {   if (defined($hash{'map_start_'.$uri})) {
  &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);
         &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 (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;      $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))) {   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>"); 
     }   }
 # ---------------------------------------------------- Store away initial state  # ---------------------------------------------------- Store away initial state
     {   {
      my $cfh;      my $cfh;
      if ($cfh=Apache::File->new(">$fn.state")) {      if ($cfh=Apache::File->new(">$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 {      } else {
       &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>"); 
    }      }
    &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';
         }          }
     }      }
    return ($retfurl,$errtext);      return ($retfurl,$errtext);
 }  }
   
 # ------------------------------------------------------- Evaluate state string  # ------------------------------------------------------- Evaluate state string

Removed from v.1.84  
changed lines
  Added in v.1.85


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