File:  [LON-CAPA] / rat / lonuserstate.pm
Revision 1.14: download - view: text, annotated - select for diffs
Tue Oct 31 19:31:42 2000 UTC (23 years, 6 months ago) by www
Branches: MAIN
CVS tags: HEAD
Clear out junk from session environment, and puts in http referers

    1: # The LearningOnline Network with CAPA
    2: # Construct and maintain state and binary representation of course for user
    3: #
    4: # (Server for RAT Maps
    5: #
    6: # (Edit Handler for RAT Maps
    7: # (TeX Content Handler
    8: #
    9: # 05/29/00,05/30 Gerd Kortemeyer)
   10: # 7/1 Gerd Kortemeyer)
   11: # 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)
   12: #
   13: # 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,
   14: # 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31 Gerd Kortemeyer
   15: 
   16: package Apache::lonuserstate;
   17: 
   18: use strict;
   19: use Apache::Constants qw(:common :http);
   20: use Apache::File;
   21: use HTML::TokeParser;
   22: use Apache::lonnet();
   23: use GDBM_File;
   24: use Apache::lonmsg;
   25: 
   26: # ---------------------------------------------------- Globals for this package
   27: 
   28: my $pc;      # Package counter
   29: my %hash;    # The big tied hash
   30: my @cond;    # Array with all of the conditions
   31: my $errtext; # variable with all errors
   32: 
   33: # --------------------------------------------------------- Loads map from disk
   34: 
   35: sub loadmap { 
   36:     my $uri=shift;
   37:     if ($hash{'map_pc_'.$uri}) { return OK; }
   38: 
   39:     $pc++;
   40:     my $lpc=$pc;
   41:     $hash{'map_pc_'.$uri}=$lpc;
   42:     $hash{'map_id_'.$lpc}=$uri;
   43: 
   44:     my $fn='/home/httpd/html'.$uri;
   45: 
   46:     unless (($fn=~/\.sequence$/) ||
   47:             ($fn=~/\.page$/)) { 
   48:        $errtext.="Invalid map: $fn\n";
   49:        return OK; 
   50:     }
   51: 
   52:     unless (-e $fn) {
   53: 	my $returned=Apache::lonnet::repcopy($fn);
   54:         unless ($returned eq OK) {
   55:            $errtext.="Could not import: $fn - ";
   56:            if ($returned eq HTTP_SERVICE_UNAVAILABLE) {
   57: 	      $errtext.="Server unavailable\n";
   58:            }
   59:            if ($returned eq HTTP_NOT_FOUND) {
   60: 	      $errtext.="File not found\n";
   61:            }
   62:            if ($returned eq FORBIDDEN) {
   63: 	      $errtext.="Access forbidden\n";
   64:            }
   65:            return OK;
   66:        }
   67:     }
   68: 
   69:     if (-e $fn) {
   70:         my @content;
   71:         {
   72: 	    my $fh=Apache::File->new($fn);
   73:             @content=<$fh>;
   74:         }
   75:         my $instr=join('',@content);
   76:         my $parser = HTML::TokeParser->new(\$instr);
   77:         my $token;
   78: 
   79:         my $linkpc=0;
   80: 
   81:         $fn=~/\.(\w+)$/;
   82: 
   83:         $hash{'map_type_'.$lpc}=$1;
   84: 
   85:         while ($token = $parser->get_token) {
   86: 	    if ($token->[0] eq 'S') {
   87:                 if ($token->[1] eq 'resource') {
   88: # -------------------------------------------------------------------- Resource
   89: 
   90:                     my $rid=$lpc.'.'.$token->[2]->{'id'};
   91: 
   92:                     $hash{'kind_'.$rid}='res';
   93:                     $hash{'title_'.$rid}=$token->[2]->{'title'};
   94:                     my $turi=$token->[2]->{'src'};
   95:                     $hash{'src_'.$rid}=$turi;
   96: 
   97:                     if (defined($hash{'ids_'.$turi})) {
   98:                         $hash{'ids_'.$turi}.=','.$rid;
   99:                     } else {
  100:                         $hash{'ids_'.$turi}=''.$rid;
  101:                     }
  102: 
  103:                     if ($token->[2]->{'src'}=~/\/\//) {
  104:                         $hash{'ext_'.$rid}='true:';
  105:                     } else {
  106:                         $hash{'ext_'.$rid}='false:';
  107:                     }
  108:                     if ($token->[2]->{'type'}) {
  109: 			$hash{'type_'.$rid}=$token->[2]->{'type'};
  110:                         if ($token->[2]->{'type'} eq 'start') {
  111: 			    $hash{'map_start_'.$uri}="$rid";
  112:                         }
  113:                         if ($token->[2]->{'type'} eq 'finish') {
  114: 			    $hash{'map_finish_'.$uri}="$rid";
  115:                         }
  116:                     }  else {
  117:                         $hash{'type_'.$rid}='normal';
  118:                     }
  119: 
  120:                     if (($turi=~/\.sequence$/) ||
  121:                         ($turi=~/\.page$/)) {
  122:                         $hash{'is_map_'.$rid}=1;
  123:                         &loadmap($turi);
  124:                     } 
  125:                     
  126:                 } elsif ($token->[1] eq 'condition') {
  127: # ------------------------------------------------------------------- Condition
  128: 
  129:                     my $rid=$lpc.'.'.$token->[2]->{'id'};
  130: 
  131:                     $hash{'kind_'.$rid}='cond';
  132:                     $cond[$#cond+1]=$token->[2]->{'value'};
  133:                     $hash{'condid_'.$rid}=$#cond;
  134:                     if ($token->[2]->{'type'}) {
  135:                         $cond[$#cond].=':'.$token->[2]->{'type'};
  136:                     }  else {
  137:                         $cond[$#cond].=':normal';
  138:                     }
  139: 
  140:                 } elsif ($token->[1] eq 'link') {
  141: # ----------------------------------------------------------------------- Links
  142: 
  143:                     $linkpc++;
  144:                     my $linkid=$lpc.'.'.$linkpc;
  145: 
  146:                     my $goesto=$lpc.'.'.$token->[2]->{'to'};
  147:                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};
  148:                     my $undercond=0;
  149: 
  150:                     if ($token->[2]->{'condition'}) {
  151: 			$undercond=$lpc.'.'.$token->[2]->{'condition'};
  152:                     }
  153: 
  154:                     $hash{'goesto_'.$linkid}=$goesto;
  155:                     $hash{'comesfrom_'.$linkid}=$comesfrom;
  156:                     $hash{'undercond_'.$linkid}=$undercond;
  157: 
  158:                     if (defined($hash{'to_'.$comesfrom})) {
  159:                         $hash{'to_'.$comesfrom}.=','.$linkid;
  160:                     } else {
  161:                         $hash{'to_'.$comesfrom}=''.$linkid;
  162:                     }
  163:                     if (defined($hash{'from_'.$goesto})) {
  164:                         $hash{'from_'.$goesto}.=','.$linkid;
  165:                     } else {
  166:                         $hash{'from_'.$goesto}=''.$linkid;
  167:                     }
  168:                 } 
  169: 
  170:             }
  171:         }
  172: 
  173:     } else {
  174:         $errtext.='Map not loaded: The file does not exist. ';
  175:     }
  176: }
  177: 
  178: # --------------------------------------------------------- Simplify expression
  179: 
  180: sub simplify {
  181:    my $expression=shift;
  182: # (8)=8
  183:    $expression=~s/\((\d+)\)/$1/g;
  184: # 8&8=8
  185:    $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g;
  186: # 8|8=8
  187:    $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g;
  188: # (5&3)&4=5&3&4
  189:    $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g;
  190: # (((5&3)|(4&6)))=((5&3)|(4&6))
  191:    $expression=~
  192:        s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;
  193: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
  194:    $expression=~
  195:        s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
  196:    return $expression;
  197: }
  198: 
  199: # -------------------------------------------------------- Build condition hash
  200: 
  201: sub traceroute {
  202:     my ($sofar,$rid,$beenhere)=@_;
  203:     $sofar=simplify($sofar);
  204:     unless ($beenhere=~/\&$rid\&/) {
  205:        $beenhere.=$rid.'&';  
  206:        if (defined($hash{'conditions_'.$rid})) {
  207: 	   $hash{'conditions_'.$rid}=simplify(
  208:            '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
  209:        } else {
  210:            $hash{'conditions_'.$rid}=$sofar;
  211:        }
  212:        if (defined($hash{'is_map_'.$rid})) {
  213:            if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
  214: 	       &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
  215:                if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
  216: 		   $sofar=
  217:                   $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
  218:                }
  219:            }
  220:        }
  221:        if (defined($hash{'to_'.$rid})) {
  222:           map {
  223: 		my $further=$sofar;
  224:                 if ($hash{'undercond_'.$_}) {
  225: 		   if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
  226:   		       $further=simplify('('.$further.')&('.
  227:                               $hash{'condid_'.$hash{'undercond_'.$_}}.')');
  228: 		   } else {
  229:                        $errtext.='Undefined condition ID: '
  230:                                  .$hash{'undercond_'.$_}.'. ';
  231:                    }
  232:                 }
  233:                 &traceroute($further,$hash{'goesto_'.$_},$beenhere);
  234:           } split(/\,/,$hash{'to_'.$rid});
  235:        }
  236:     }
  237: }
  238: 
  239: # ------------------------------------------ Cascading conditions, quick access
  240: 
  241: sub accinit {
  242:     my ($uri,$short,$fn)=@_;
  243:     my %acchash=();
  244:     my %captured=();
  245:     my $condcounter=0;
  246:     $acchash{'acc.cond.'.$short.'.0'}=0;
  247:     map {
  248:        if ($_=~/^conditions/) {
  249: 	  my $expr=$hash{$_};
  250:           map {
  251:              my $sub=$_;
  252:              my $orig=$_;
  253:       $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;
  254:              my $factor=$1;
  255:              $sub=~s/$factor//g;
  256:              $sub=~s/^\(/\($factor\(/;
  257: 	     $sub.=')';
  258:              $sub=simplify($sub);
  259:              $orig=~s/(\W)/\\$1/g;
  260:  	     $expr=~s/$orig/$sub/;
  261: 	  } ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g);
  262:           $hash{$_}=$expr;
  263:           unless (defined($captured{$expr})) {
  264: 	      $condcounter++;
  265:               $captured{$expr}=$condcounter;
  266:               $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
  267:           } 
  268:         }
  269:     } keys %hash;
  270:     map {
  271: 	if ($_=~/^ids/) {
  272: 	  map {
  273: 	    my $resid=$_;
  274:             my $uri=$hash{'src_'.$resid};
  275:             my @uriparts=split(/\//,$uri);
  276:             my $urifile=$uriparts[$#uriparts];
  277:             $#uriparts--;
  278:             my $uripath=join('/',@uriparts);
  279:             $uripath=~s/^\/res\///;
  280:             my $uricond='0';
  281:             if (defined($hash{'conditions_'.$resid})) {
  282:  		$uricond=$captured{$hash{'conditions_'.$resid}};
  283:             }
  284:             if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
  285:                 if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
  286:                    /(\&$urifile\:[^\&]*)/) {
  287: 		    my $replace=$1;
  288:                     $acchash{'acc.res.'.$short.'.'.$uripath}
  289:                      =~s/$replace/$replace\|$uricond/;
  290:                 } else {
  291: 		   $acchash{'acc.res.'.$short.'.'.$uripath}.=
  292:                      $urifile.':'.$uricond.'&';
  293: 	        }
  294:             } else {
  295:                 $acchash{'acc.res.'.$short.'.'.$uripath}=
  296:                  '&'.$urifile.':'.$uricond.'&';
  297:             } 
  298:          } split(/\,/,$hash{$_});
  299:       }
  300:     } keys %hash;
  301:     my $courseuri=$uri;
  302:     $courseuri=~s/^\/res\///;
  303:     &Apache::lonnet::delenv('(acc\.|httpref\.)');
  304:     &Apache::lonnet::appenv(%acchash,
  305:                             "request.course.id"  => $short,
  306:                             "request.course.fn"  => $fn,
  307:                             "request.course.uri" => $courseuri); 
  308: }
  309: 
  310: # ---------------------------------------------------- Read map and all submaps
  311: 
  312: sub readmap {
  313:    my $short=shift;
  314:    $short=~s/^\///;
  315:    my %cenv=&Apache::lonnet::coursedescription($short);
  316:    my $fn=$cenv{'fn'};
  317:    my $uri;
  318:    $short=~s/\//\_/g;
  319:    unless ($uri=$cenv{'url'}) { 
  320:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  321:                        "Could not load course $short.</font>"); 
  322:       return 'No course data available.';
  323:    }
  324:    @cond=('true:normal');
  325:    unlink($fn.'.db');
  326:    unlink($fn.'_symb.db');
  327:    unlink($fn.'.state');
  328:    if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) {
  329:     %hash=();
  330:     $errtext='';
  331:     $pc=0;
  332:     loadmap($uri);
  333:     if (defined($hash{'map_start_'.$uri})) {
  334:         &traceroute('0',$hash{'map_start_'.$uri},'&');
  335:         &accinit($uri,$short,$fn);
  336:     }
  337:     unless (untie(%hash)) {
  338:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  339:                        "Could not untie coursemap $fn for $uri.</font>"); 
  340:     }
  341:     {
  342:      my $cfh;
  343:      if ($cfh=Apache::File->new(">$fn.state")) {
  344:         print $cfh join("\n",@cond);
  345:      } else {
  346:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  347:                        "Could not write statemap $fn for $uri.</font>"); 
  348:      }
  349:     }  
  350:    } else {
  351:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  352:                        "Could not tie coursemap $fn for $uri.</font>"); 
  353:    }
  354:    &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
  355:    return $errtext;
  356: }
  357:  
  358: 1;
  359: __END__
  360: 
  361: 
  362: 
  363: 
  364: 
  365: 
  366: 

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