Annotation of rat/lonuserstate.pm, revision 1.61

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