File:  [LON-CAPA] / rat / lonuserstate.pm
Revision 1.10: download - view: text, annotated - select for diffs
Mon Oct 2 16:16:06 2000 UTC (23 years, 7 months ago) by www
Branches: MAIN
CVS tags: HEAD
Eliminate type course

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

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