Annotation of rat/lonuserstate.pm, revision 1.67

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.