File:  [LON-CAPA] / rat / lonuserstate.pm
Revision 1.68: download - view: text, annotated - select for diffs
Fri Dec 12 16:38:53 2003 UTC (20 years, 4 months ago) by www
Branches: MAIN
CVS tags: version_1_0_99_2, HEAD
Bug #2453: pretty bad, fix should go into 1.1

Since the publisher does not longer change every URL into an absolute path,
and we are officially allowing relative sources in maps, we have to have
lonuserstate do a hreflocation of map source with respect to the map
location.

    1: # The LearningOnline Network with CAPA
    2: # Construct and maintain state and binary representation of course for user
    3: #
    4: # $Id: lonuserstate.pm,v 1.68 2003/12/12 16:38:53 www Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::lonuserstate;
   31: 
   32: # ------------------------------------------------- modules used by this module
   33: use strict;
   34: use Apache::Constants qw(:common :http);
   35: use Apache::File;
   36: use HTML::TokeParser;
   37: use Apache::lonnet();
   38: use Apache::loncommon();
   39: use GDBM_File;
   40: use Apache::lonmsg;
   41: use Safe;
   42: use Safe::Hole;
   43: use Opcode;
   44: 
   45: # ---------------------------------------------------- Globals for this package
   46: 
   47: my $pc;      # Package counter
   48: my %hash;    # The big tied hash
   49: my %parmhash;# The hash with the parameters
   50: my @cond;    # Array with all of the conditions
   51: my $errtext; # variable with all errors
   52: my $retfurl; # variable with the very first URL in the course
   53: my %randompick; # randomly picked resources
   54: my %randompickseed; # optional seed for randomly picking resources
   55: 
   56: # ----------------------------------- Remove version from URL and store in hash
   57: 
   58: sub versiontrack {
   59:     my $uri=shift;
   60:     if ($uri=~/\.(\d+)\.\w+$/) {
   61: 	my $version=$1;
   62: 	$uri=~s/\.\d+\.(\w+)$/\.$1/;
   63:         unless ($hash{'version_'.$uri}) {
   64: 	    $hash{'version_'.$uri}=$version;
   65: 	}
   66:     }
   67:     return $uri;
   68: }
   69: 
   70: # -------------------------------------------------------------- Put in version
   71: 
   72: sub putinversion {
   73:     my $uri=shift;
   74:     if ($hash{'version_'.$uri}) {
   75: 	my $version=$hash{'version_'.$uri};
   76: 	if ($version eq 'mostrecent') { return $uri; }
   77: 	if ($version eq &Apache::lonnet::getversion(
   78: 			&Apache::lonnet::filelocation('',$uri))) 
   79: 	             { return $uri; }
   80: 	$uri=~s/\.(\w+)$/\.$version\.$1/;
   81:     }
   82:     return $uri;
   83: }
   84: 
   85: # ----------------------------------------- Processing versions file for course
   86: 
   87: sub processversionfile {
   88:     my %cenv=@_;
   89:     my %versions=&Apache::lonnet::dump('resourceversions',
   90: 				       $cenv{'domain'},
   91: 				       $cenv{'num'});
   92:     foreach (keys %versions) {
   93: 	if ($_=~/^error\:/) { return; }
   94: 	$hash{'version_'.$_}=$versions{$_};
   95:     }
   96: }
   97: 
   98: # --------------------------------------------------------- Loads map from disk
   99: 
  100: sub loadmap { 
  101:     my $uri=shift;
  102:     if ($hash{'map_pc_'.$uri}) { return OK; }
  103: 
  104:     $pc++;
  105:     my $lpc=$pc;
  106:     $hash{'map_pc_'.$uri}=$lpc;
  107:     $hash{'map_id_'.$lpc}=$uri;
  108: 
  109: # Determine and check filename
  110:     my $fn=&Apache::lonnet::filelocation('',&putinversion($uri));
  111: 
  112:     my $ispage=($fn=~/\.page$/);
  113: 
  114:     unless (($fn=~/\.sequence$/) ||
  115:             ($fn=~/\.page$/)) { 
  116:        $errtext.="Invalid map: $fn\n";
  117:        return OK; 
  118:     }
  119: 
  120:     my $instr=&Apache::lonnet::getfile($fn);
  121: 
  122:     unless ($instr eq -1) {
  123: 
  124: # Successfully got file, parse it
  125: 
  126:         my $parser = HTML::TokeParser->new(\$instr);
  127:         my $token;
  128: 
  129:         my $linkpc=0;
  130: 
  131:         $fn=~/\.(\w+)$/;
  132: 
  133:         $hash{'map_type_'.$lpc}=$1;
  134: 
  135:         while ($token = $parser->get_token) {
  136: 	    if ($token->[0] eq 'S') {
  137:                 if ($token->[1] eq 'resource') {
  138: # -------------------------------------------------------------------- Resource
  139: 
  140:                     my $rid=$lpc.'.'.$token->[2]->{'id'};
  141: 
  142:                     $hash{'kind_'.$rid}='res';
  143:                     $hash{'title_'.$rid}=$token->[2]->{'title'};
  144:                     my $turi=&versiontrack($token->[2]->{'src'});
  145:                     if ($token->[2]->{'version'}) {
  146: 			unless ($hash{'version_'.$turi}) {
  147: 			    $hash{'version_'.$turi}=$1;
  148: 			}
  149: 		    }
  150: 		    &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache,
  151: 		       &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'},
  152: 						    $turi),
  153: 					      $token->[2]->{'title'},'title');
  154:                     unless ($ispage) {
  155:                         $turi=~/\.(\w+)$/;
  156:                         my $embstyle=&Apache::loncommon::fileembstyle($1);
  157:                         if ($token->[2]->{'external'} eq 'true') { # external
  158:                             $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
  159:                         } elsif ($turi=~/^\/*uploaded\//) { # uploaded
  160: 			    if (($embstyle eq 'img') || ($embstyle eq 'emb')
  161:                              || ($embstyle eq 'ssi')) {
  162:                                 $turi='/adm/wrapper'.$turi;
  163:                             } elsif ($turi!~/\.(sequence|page)$/) {
  164: 				$turi='/adm/coursedocs/showdoc'.$turi;
  165:                             }
  166:                         } else { # normal internal resource
  167: 			    my $mapdir=$uri;
  168: 			    $mapdir=~s/[^\/]+$//;
  169: 			    $turi=&Apache::lonnet::hreflocation($mapdir,$turi);
  170: 			    if (($embstyle eq 'img') || ($embstyle eq 'emb')) {
  171: 				$turi='/adm/wrapper'.$turi;
  172: 			    }
  173:                         }
  174: 		    }
  175: 
  176:                     if (defined($hash{'ids_'.$turi})) {
  177:                         $hash{'ids_'.$turi}.=','.$rid;
  178:                     } else {
  179:                         $hash{'ids_'.$turi}=''.$rid;
  180:                     }
  181:                
  182:                     if
  183: 	        ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) {
  184: 			$turi.='?register=1';
  185: 		    }
  186: 
  187:                     $hash{'src_'.$rid}=$turi;
  188: 
  189:                     if ($token->[2]->{'external'} eq 'true') {
  190:                         $hash{'ext_'.$rid}='true:';
  191:                     } else {
  192:                         $hash{'ext_'.$rid}='false:';
  193:                     }
  194:                     if ($token->[2]->{'type'}) {
  195: 			$hash{'type_'.$rid}=$token->[2]->{'type'};
  196:                         if ($token->[2]->{'type'} eq 'start') {
  197: 			    $hash{'map_start_'.$uri}="$rid";
  198:                         }
  199:                         if ($token->[2]->{'type'} eq 'finish') {
  200: 			    $hash{'map_finish_'.$uri}="$rid";
  201:                         }
  202:                     }  else {
  203:                         $hash{'type_'.$rid}='normal';
  204:                     }
  205: 
  206:                     if (($turi=~/\.sequence$/) ||
  207:                         ($turi=~/\.page$/)) {
  208:                         $hash{'is_map_'.$rid}=1;
  209:                         &loadmap($turi);
  210:                     } 
  211:                     
  212:                 } elsif ($token->[1] eq 'condition') {
  213: # ------------------------------------------------------------------- Condition
  214: 
  215:                     my $rid=$lpc.'.'.$token->[2]->{'id'};
  216: 
  217:                     $hash{'kind_'.$rid}='cond';
  218:                     $cond[$#cond+1]=$token->[2]->{'value'};
  219:                     $hash{'condid_'.$rid}=$#cond;
  220:                     if ($token->[2]->{'type'}) {
  221:                         $cond[$#cond].=':'.$token->[2]->{'type'};
  222:                     }  else {
  223:                         $cond[$#cond].=':normal';
  224:                     }
  225: 
  226:                 } elsif ($token->[1] eq 'link') {
  227: # ----------------------------------------------------------------------- Links
  228: 
  229:                     $linkpc++;
  230:                     my $linkid=$lpc.'.'.$linkpc;
  231: 
  232:                     my $goesto=$lpc.'.'.$token->[2]->{'to'};
  233:                     my $comesfrom=$lpc.'.'.$token->[2]->{'from'};
  234:                     my $undercond=0;
  235: 
  236:                     if ($token->[2]->{'condition'}) {
  237: 			$undercond=$lpc.'.'.$token->[2]->{'condition'};
  238:                     }
  239: 
  240:                     $hash{'goesto_'.$linkid}=$goesto;
  241:                     $hash{'comesfrom_'.$linkid}=$comesfrom;
  242:                     $hash{'undercond_'.$linkid}=$undercond;
  243: 
  244:                     if (defined($hash{'to_'.$comesfrom})) {
  245:                         $hash{'to_'.$comesfrom}.=','.$linkid;
  246:                     } else {
  247:                         $hash{'to_'.$comesfrom}=''.$linkid;
  248:                     }
  249:                     if (defined($hash{'from_'.$goesto})) {
  250:                         $hash{'from_'.$goesto}.=','.$linkid;
  251:                     } else {
  252:                         $hash{'from_'.$goesto}=''.$linkid;
  253:                     }
  254:                 } elsif ($token->[1] eq 'param') {
  255: # ------------------------------------------------------------------- Parameter
  256: 
  257:                     my $referid=$lpc.'.'.$token->[2]->{'to'};
  258: 		    my $name=$token->[2]->{'name'};
  259: 		    my $part;
  260: 		    if ($name=~/^parameter_(.*)_/) {
  261: 			$part=$1;
  262: 		    } else {
  263: 			$part=0;
  264: 		    }
  265: 		    $name=~s/^.*_([^_]*)$/$1/;
  266:                     my $newparam=
  267: 			&Apache::lonnet::escape($token->[2]->{'type'}).':'.
  268: 			&Apache::lonnet::escape($part.'.'.$name).'='.
  269: 			&Apache::lonnet::escape($token->[2]->{'value'});
  270:                     if (defined($hash{'param_'.$referid})) {
  271:                         $hash{'param_'.$referid}.='&'.$newparam;
  272:                     } else {
  273:                         $hash{'param_'.$referid}=''.$newparam;
  274:                     }
  275:                     if ($token->[2]->{'name'} eq 'parameter_mapalias') {
  276: 			$hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
  277:                     }
  278:                     if ($token->[2]->{'name'} eq 'parameter_randompick') {
  279: 			$randompick{$referid}=$token->[2]->{'value'};
  280:                     }
  281:                     if ($token->[2]->{'name'} eq 'parameter_randompickseed') {
  282: 			$randompick{$referid}=$token->[2]->{'value'};
  283:                     }
  284:                 } 
  285: 
  286:             }
  287:         }
  288: 
  289:     } else {
  290:         $errtext.='Map not loaded: The file does not exist. ';
  291:     }
  292: }
  293: 
  294: # --------------------------------------------------------- Simplify expression
  295: 
  296: sub simplify {
  297:    my $expression=shift;
  298: # (8)=8
  299:    $expression=~s/\((\d+)\)/$1/g;
  300: # 8&8=8
  301:    $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g;
  302: # 8|8=8
  303:    $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g;
  304: # (5&3)&4=5&3&4
  305:    $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g;
  306: # (((5&3)|(4&6)))=((5&3)|(4&6))
  307:    $expression=~
  308:        s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g;
  309: # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2)
  310:    $expression=~
  311:        s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g;
  312:    return $expression;
  313: }
  314: 
  315: # -------------------------------------------------------- Build condition hash
  316: 
  317: sub traceroute {
  318:     my ($sofar,$rid,$beenhere)=@_;
  319:     $sofar=simplify($sofar);
  320:     unless ($beenhere=~/\&$rid\&/) {
  321:        $beenhere.=$rid.'&';  
  322:        if (($retfurl eq '') && ($hash{'src_'.$rid})
  323:         && ($hash{'src_'.$rid}!~/\.sequence$/)) {
  324:            my ($mapid,$resid)=split(/\./,$rid);
  325:            $retfurl=$hash{'src_'.$rid}.
  326:            (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='.
  327:            &Apache::lonnet::symbclean(
  328:                            &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
  329:                            '___'.$resid.'___'.
  330:                            &Apache::lonnet::declutter($hash{'src_'.$rid}));
  331:        }
  332:        if (defined($hash{'conditions_'.$rid})) {
  333: 	   $hash{'conditions_'.$rid}=simplify(
  334:            '('.$hash{'conditions_'.$rid}.')|('.$sofar.')');
  335:        } else {
  336:            $hash{'conditions_'.$rid}=$sofar;
  337:        }
  338:        if (defined($hash{'is_map_'.$rid})) {
  339:            if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) {
  340: 	       &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&');
  341:                if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) {
  342: 		   $sofar=
  343:                   $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}};
  344:                }
  345:            }
  346:        }
  347:        if (defined($hash{'to_'.$rid})) {
  348:           foreach (split(/\,/,$hash{'to_'.$rid})) {
  349: 		my $further=$sofar;
  350:                 if ($hash{'undercond_'.$_}) {
  351: 		   if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
  352:   		       $further=simplify('('.$further.')&('.
  353:                               $hash{'condid_'.$hash{'undercond_'.$_}}.')');
  354: 		   } else {
  355:                        $errtext.='Undefined condition ID: '
  356:                                  .$hash{'undercond_'.$_}.'. ';
  357:                    }
  358:                 }
  359:                 &traceroute($further,$hash{'goesto_'.$_},$beenhere);
  360:           }
  361:        }
  362:     }
  363: }
  364: 
  365: # ------------------------------ Cascading conditions, quick access, parameters
  366: 
  367: sub accinit {
  368:     my ($uri,$short,$fn)=@_;
  369:     my %acchash=();
  370:     my %captured=();
  371:     my $condcounter=0;
  372:     $acchash{'acc.cond.'.$short.'.0'}=0;
  373:     foreach (keys %hash) {
  374:        if ($_=~/^conditions/) {
  375: 	  my $expr=$hash{$_};
  376:          foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) {
  377:              my $sub=$_;
  378:              my $orig=$_;
  379:       $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/;
  380:              my $factor=$1;
  381:              $sub=~s/$factor//g;
  382:              $sub=~s/^\(/\($factor\(/;
  383: 	     $sub.=')';
  384:              $sub=simplify($sub);
  385:              $orig=~s/(\W)/\\$1/g;
  386:  	     $expr=~s/$orig/$sub/;
  387: 	  }
  388:           $hash{$_}=$expr;
  389:           unless (defined($captured{$expr})) {
  390: 	      $condcounter++;
  391:               $captured{$expr}=$condcounter;
  392:               $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
  393:           } 
  394:        } elsif ($_=~/^param_(\d+)\.(\d+)/) {
  395:           my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}).
  396:       '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
  397:           foreach (split(/\&/,$hash{$_})) {
  398: 	     my ($typename,$value)=split(/\=/,$_);
  399:              my ($type,$name)=split(/\:/,$typename);
  400:              $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=
  401:                                    &Apache::lonnet::unescape($value);
  402: 	     $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=
  403:                                    &Apache::lonnet::unescape($type);
  404:           }
  405:        }
  406:     }
  407:     foreach (keys %hash) {
  408: 	if ($_=~/^ids/) {
  409: 	  foreach (split(/\,/,$hash{$_})) {
  410: 	    my $resid=$_;
  411:             my $uri=$hash{'src_'.$resid};
  412:             $uri=~s/^\/adm\/wrapper//;
  413:             $uri=&Apache::lonnet::declutter($uri);
  414:             my @uriparts=split(/\//,$uri);
  415:             my $urifile=$uriparts[$#uriparts];
  416:             $#uriparts--;
  417:             my $uripath=join('/',@uriparts);
  418:            if ($uripath) {
  419:             my $uricond='0';
  420:             if (defined($hash{'conditions_'.$resid})) {
  421:  		$uricond=$captured{$hash{'conditions_'.$resid}};
  422:             }
  423:             if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) {
  424:                 if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
  425:                    /(\&\Q$urifile\E\:[^\&]*)/) {
  426: 		    my $replace=$1;
  427:                     my $regexp=$replace;
  428:                     $regexp=~s/\|/\\\|/g;
  429:                     $acchash{'acc.res.'.$short.'.'.$uripath}
  430:                      =~s/$regexp/$replace\|$uricond/;
  431:                 } else {
  432: 		   $acchash{'acc.res.'.$short.'.'.$uripath}.=
  433:                      $urifile.':'.$uricond.'&';
  434: 	        }
  435:             } else {
  436:                 $acchash{'acc.res.'.$short.'.'.$uripath}=
  437:                  '&'.$urifile.':'.$uricond.'&';
  438:             }
  439:            } 
  440:          }
  441:       }
  442:     }
  443:     $acchash{'acc.res.'.$short.'.'}='&:0&';
  444:     my $courseuri=$uri;
  445:     $courseuri=~s/^\/res\///;
  446:     &Apache::lonnet::delenv('(acc\.|httpref\.)');
  447:     &Apache::lonnet::appenv(%acchash,
  448:                             "request.course.id"  => $short,
  449:                             "request.course.fn"  => $fn,
  450:                             "request.course.uri" => $courseuri); 
  451: }
  452: 
  453: # ------------------------------------- Selectively delete from randompick maps
  454: 
  455: sub pickrandom {
  456:     my $randomoutentry='';
  457:     foreach my $rid (keys %randompick) {
  458:         my $rndpick=$randompick{$rid};
  459:         my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
  460: # ------------------------------------------- put existing resources into array
  461:         my @currentrids=();
  462:         foreach (sort(keys(%hash))) {
  463: 	    if ($_=~/^src_($mpc\.\d+)/) {
  464: 		if ($hash{'src_'.$1}) { push @currentrids, $1; }
  465:             }
  466:         }
  467: 	# rids are number.number and we want to numercially sort on 
  468:         # the second number
  469: 	@currentrids=sort {
  470: 	    my (undef,$aid)=split(/\./,$a);
  471: 	    my (undef,$bid)=split(/\./,$b);
  472: 	    $aid <=> $bid;
  473: 	} @currentrids;
  474:         next if ($#currentrids<$rndpick);
  475: # -------------------------------- randomly eliminate the ones that should stay
  476: 	my (undef,$id)=split(/\./,$rid);
  477:         if ($randompickseed{$rid}) { $id=$randompickseed{$rid}; }
  478: 	my $rndseed=&Apache::lonnet::rndseed($id); # use id instead of symb
  479: 	&Apache::lonnet::setup_random_from_rndseed($rndseed);
  480: 	my @whichids=&Math::Random::random_permuted_index($#currentrids+1);
  481:         for (my $i=1;$i<=$rndpick;$i++) { $currentrids[$whichids[$i]]=''; }
  482: 	#&Apache::lonnet::logthis("$id,$rndseed,".join(':',@whichids));
  483: # -------------------------------------------------------- delete the leftovers
  484:         for (my $k=0; $k<=$#currentrids; $k++) {
  485:             if ($currentrids[$k]) {
  486: 		$hash{'randomout_'.$currentrids[$k]}=1;
  487:                 my ($mapid,$resid)=split(/\./,$currentrids[$k]);
  488:                 $randomoutentry.='&'.
  489:                  &Apache::lonnet::symbclean(
  490: 		    &Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
  491:                     '___'.$resid.'___'.
  492: 		    &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})
  493:                  ).'&';
  494:             }
  495:         }
  496:     }
  497:     if ($randomoutentry) {
  498: 	&Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
  499:     }
  500: }
  501: 
  502: # ---------------------------------------------------- Read map and all submaps
  503: 
  504: sub readmap {
  505:    my $short=shift;
  506:    $short=~s/^\///;
  507:    my %cenv=&Apache::lonnet::coursedescription($short);
  508:    my $fn=$cenv{'fn'};
  509:    my $uri;
  510:    $short=~s/\//\_/g;
  511:    unless ($uri=$cenv{'url'}) { 
  512:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  513:                        "Could not load course $short.</font>"); 
  514:       return 'No course data available.';
  515:    }
  516:    @cond=('true:normal');
  517:    unlink($fn.'.db');
  518:    unlink($fn.'_symb.db');
  519:    unlink($fn.'.state');
  520:    unlink($fn.'parms.db');
  521:    undef %randompick;
  522:    $retfurl='';
  523:    if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
  524:        (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
  525:     %hash=();
  526:     %parmhash=();
  527:     $errtext='';
  528:     $pc=0;
  529:     &processversionfile(%cenv);
  530:     my $furi=&Apache::lonnet::clutter($uri);
  531:     $hash{'src_0.0'}=&versiontrack($furi);
  532:     $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
  533:     $hash{'ids_'.$furi}='0.0';
  534:     $hash{'is_map_0.0'}=1;
  535:     loadmap($uri);
  536:     if (defined($hash{'map_start_'.$uri})) {
  537:         &traceroute('0',$hash{'map_start_'.$uri},'&');
  538:         &accinit($uri,$short,$fn);
  539:         &pickrandom();
  540:     }
  541: # ------------------------------------------------------- Put versions into src
  542:     foreach (keys %hash) {
  543: 	if ($_=~/^src\_/) {
  544: 	    $hash{$_}=&putinversion($hash{$_});
  545: 	}
  546:     }
  547:     unless ((untie(%hash)) && (untie(%parmhash))) {
  548:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  549:                        "Could not untie coursemap $fn for $uri.</font>"); 
  550:     }
  551:     {
  552:      my $cfh;
  553:      if ($cfh=Apache::File->new(">$fn.state")) {
  554:         print $cfh join("\n",@cond);
  555:      } else {
  556:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  557:                        "Could not write statemap $fn for $uri.</font>"); 
  558:      }
  559:     }  
  560:    } else {
  561:       &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  562:                        "Could not tie coursemap $fn for $uri.</font>"); 
  563:    }
  564:    &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
  565: # ------------------------------------------------- Check for critical messages
  566: 
  567:     my @what=&Apache::lonnet::dump('critical',$ENV{'user.domain'},
  568:                                               $ENV{'user.name'});
  569:     if ($what[0]) {
  570: 	if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
  571: 	    $retfurl='/adm/email?critical=display';
  572:         }
  573:     }
  574:    return ($retfurl,$errtext);
  575: }
  576: 
  577: # ------------------------------------------------------- Evaluate state string
  578: 
  579: sub evalstate {
  580: 
  581:     my $fn=$ENV{'request.course.fn'}.'.state';
  582:     my $state='2';
  583:     if (-e $fn) {
  584:        my @conditions=();
  585:        {
  586:         my $fh=Apache::File->new($fn);
  587:         @conditions=<$fh>;
  588:        }  
  589:        my $safeeval = new Safe;
  590:        my $safehole = new Safe::Hole;
  591:        $safeeval->permit("entereval");
  592:        $safeeval->permit(":base_math");
  593:        $safeeval->deny(":base_io");
  594:        $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  595:        foreach (@conditions) {
  596: 	   my $line=$_;
  597:            chomp($line);
  598: 	   my ($condition,$weight)=split(/\:/,$_);
  599:            if ($safeeval->reval($condition)) {
  600: 	       if ($weight eq 'force') {
  601: 		   $state.='3';
  602:                } else {
  603:                    $state.='2';
  604:                }
  605:            } else {
  606:                if ($weight eq 'stop') {
  607: 		   $state.='0';
  608:                } else {
  609:                    $state.='1';
  610:                }
  611:            }
  612:        }
  613:     }
  614:     &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);
  615:     return $state;
  616: }
  617: 
  618: 1;
  619: __END__
  620: 
  621: =head1 NAME
  622: 
  623: Apache::lonuserstate - Construct and maintain state and binary representation
  624: of course for user
  625: 
  626: =head1 SYNOPSIS
  627: 
  628: Invoked by lonroles.pm.
  629: 
  630: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  631: 
  632: =head1 INTRODUCTION
  633: 
  634: This module constructs and maintains state and binary representation
  635: of course for user.
  636: 
  637: This is part of the LearningOnline Network with CAPA project
  638: described at http://www.lon-capa.org.
  639: 
  640: =head1 HANDLER SUBROUTINE
  641: 
  642: There is no handler subroutine.
  643: 
  644: =head1 OTHER SUBROUTINES
  645: 
  646: =over 4
  647: 
  648: =item *
  649: 
  650: loadmap() : Loads map from disk
  651: 
  652: =item *
  653: 
  654: simplify() : Simplify expression
  655: 
  656: =item *
  657: 
  658: traceroute() : Build condition hash
  659: 
  660: =item *
  661: 
  662: accinit() : Cascading conditions, quick access, parameters
  663: 
  664: =item *
  665: 
  666: readmap() : Read map and all submaps
  667: 
  668: =item *
  669: 
  670: evalstate() : Evaluate state string
  671: 
  672: =back
  673: 
  674: =cut

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