--- rat/lonuserstate.pm 2005/02/17 09:09:11 1.84 +++ rat/lonuserstate.pm 2005/03/15 17:21:42 1.85 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Construct and maintain state and binary representation of course for user # -# $Id: lonuserstate.pm,v 1.84 2005/02/17 09:09:11 albertel Exp $ +# $Id: lonuserstate.pm,v 1.85 2005/03/15 17:21:42 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -116,8 +116,8 @@ sub loadmap { unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { - $errtext.="Invalid map: $fn\n"; - return OK; + $errtext.="Invalid map: $fn\n"; + return OK; } my $instr=&Apache::lonnet::getfile($fn); @@ -187,8 +187,7 @@ sub loadmap { $hash{'ids_'.$idsuri}=''.$rid; } - if - ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { + if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { $turi.='?register=1'; } @@ -300,7 +299,7 @@ sub loadmap { } } } - + } } @@ -312,22 +311,22 @@ sub loadmap { # --------------------------------------------------------- Simplify expression sub simplify { - my $expression=shift; + my $expression=shift; # (8)=8 - $expression=~s/\((\d+)\)/$1/g; + $expression=~s/\((\d+)\)/$1/g; # 8&8=8 - $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; + $expression=~s/(\D)(\d+)\&\2(\D)/$1$2$3/g; # 8|8=8 - $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g; + $expression=~s/(\D)(\d+)\|\2(\D)/$1$2$3/g; # (5&3)&4=5&3&4 - $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g; + $expression=~s/\((\d+)((?:\&\d+)+)\)\&(\d+\D)/$1$2\&$3/g; # (((5&3)|(4&6)))=((5&3)|(4&6)) - $expression=~ - s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; + $expression=~ + s/\((\(\(\d+(?:\&\d+)*\)(?:\|\(\d+(?:\&\d+)*\))+\))\)/$1/g; # ((5&3)|(4&6))|(1&2)=(5&3)|(4&6)|(1&2) - $expression=~ - s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g; - return $expression; + $expression=~ + s/\((\(\d+(?:\&\d+)*\))((?:\|\(\d+(?:\&\d+)*\))+)\)\|(\(\d+(?:\&\d+)*\))/\($1$2\|$3\)/g; + return $expression; } # -------------------------------------------------------- Build condition hash @@ -336,50 +335,50 @@ sub traceroute { my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; my $newsofar=$sofar=simplify($sofar); unless ($beenhere=~/\&$rid\&/) { - $beenhere.=$rid.'&'; - my ($mapid,$resid)=split(/\./,$rid); - my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); - my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb); - if ($hdnflag || lc($hidden) eq 'yes') { $hiddenurl{$rid}=1; } - my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); - if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } - if (($retfurl eq '') && ($hash{'src_'.$rid}) - && ($hash{'src_'.$rid}!~/\.sequence$/)) { - $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?'). - 'symb='.$symb; - } - if (defined($hash{'conditions_'.$rid})) { - $hash{'conditions_'.$rid}=simplify( + $beenhere.=$rid.'&'; + my ($mapid,$resid)=split(/\./,$rid); + my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); + my $hidden=&Apache::lonnet::EXT('resource.0.hiddenresource',$symb); + if ($hdnflag || lc($hidden) eq 'yes') { $hiddenurl{$rid}=1; } + my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); + if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } + if (($retfurl eq '') && ($hash{'src_'.$rid}) + && ($hash{'src_'.$rid}!~/\.sequence$/)) { + $retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?'). + 'symb='.$symb; + } + if (defined($hash{'conditions_'.$rid})) { + $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); - } else { - $hash{'conditions_'.$rid}=$sofar; - } - $newsofar=$hash{'conditions_'.$rid}; - if (defined($hash{'is_map_'.$rid})) { - if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { - $sofar=$newsofar= - &traceroute($sofar, - $hash{'map_start_'.$hash{'src_'.$rid}},'&', - $encflag || $encurl{$rid}, - $hdnflag || $hiddenurl{$rid}); - } - } - if (defined($hash{'to_'.$rid})) { - foreach (split(/\,/,$hash{'to_'.$rid})) { + } else { + $hash{'conditions_'.$rid}=$sofar; + } + $newsofar=$hash{'conditions_'.$rid}; + if (defined($hash{'is_map_'.$rid})) { + if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { + $sofar=$newsofar= + &traceroute($sofar, + $hash{'map_start_'.$hash{'src_'.$rid}},'&', + $encflag || $encurl{$rid}, + $hdnflag || $hiddenurl{$rid}); + } + } + if (defined($hash{'to_'.$rid})) { + foreach (split(/\,/,$hash{'to_'.$rid})) { my $further=$sofar; if ($hash{'undercond_'.$_}) { - if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) { - $further=simplify('('.$further.')&('. - $hash{'condid_'.$hash{'undercond_'.$_}}.')'); - } else { - $errtext.='Undefined condition ID: ' - .$hash{'undercond_'.$_}.'. '; - } + if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) { + $further=simplify('('.$further.')&('. + $hash{'condid_'.$hash{'undercond_'.$_}}.')'); + } else { + $errtext.='Undefined condition ID: ' + .$hash{'undercond_'.$_}.'. '; + } } $newsofar=&traceroute($further,$hash{'goesto_'.$_},$beenhere, $encflag,$hdnflag); - } - } + } + } } return $newsofar; } @@ -393,74 +392,74 @@ sub accinit { my $condcounter=0; $acchash{'acc.cond.'.$short.'.0'}=0; foreach (keys %hash) { - if ($_=~/^conditions/) { - my $expr=$hash{$_}; - foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) { - my $sub=$_; - my $orig=$_; - $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; - my $factor=$1; - $sub=~s/$factor//g; - $sub=~s/^\(/\($factor\(/; - $sub.=')'; - $sub=simplify($sub); - $orig=~s/(\W)/\\$1/g; - $expr=~s/$orig/$sub/; - } - $hash{$_}=$expr; - unless (defined($captured{$expr})) { - $condcounter++; - $captured{$expr}=$condcounter; - $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; - } - } elsif ($_=~/^param_(\d+)\.(\d+)/) { - my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}). - '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2}); - foreach (split(/\&/,$hash{$_})) { - my ($typename,$value)=split(/\=/,$_); - my ($type,$name)=split(/\:/,$typename); - $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}= - &Apache::lonnet::unescape($type); - } - } + if ($_=~/^conditions/) { + my $expr=$hash{$_}; + foreach ($expr=~m/(\(\(\d+(?:\&\d+)+\)(?:\|\(\d+(?:\&\d+)+\))+\))/g) { + my $sub=$_; + my $orig=$_; + $sub=~/\(\((\d+\&(:?\d+\&)*)(?:\d+\&*)+\)(?:\|\(\1(?:\d+\&*)+\))+\)/; + my $factor=$1; + $sub=~s/$factor//g; + $sub=~s/^\(/\($factor\(/; + $sub.=')'; + $sub=simplify($sub); + $orig=~s/(\W)/\\$1/g; + $expr=~s/$orig/$sub/; + } + $hash{$_}=$expr; + unless (defined($captured{$expr})) { + $condcounter++; + $captured{$expr}=$condcounter; + $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; + } + } elsif ($_=~/^param_(\d+)\.(\d+)/) { + my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}). + '___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2}); + foreach (split(/\&/,$hash{$_})) { + my ($typename,$value)=split(/\=/,$_); + my ($type,$name)=split(/\:/,$typename); + $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + $parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}= + &Apache::lonnet::unescape($type); + } + } } foreach (keys %hash) { if ($_=~/^ids/) { - foreach (split(/\,/,$hash{$_})) { - my $resid=$_; - my $uri=$hash{'src_'.$resid}; - $uri=~s/^\/adm\/wrapper//; - $uri=&Apache::lonnet::declutter($uri); - my @uriparts=split(/\//,$uri); - my $urifile=$uriparts[$#uriparts]; - $#uriparts--; - my $uripath=join('/',@uriparts); - if ($uripath) { - my $uricond='0'; - if (defined($hash{'conditions_'.$resid})) { - $uricond=$captured{$hash{'conditions_'.$resid}}; - } - if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { - if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ - /(\&\Q$urifile\E\:[^\&]*)/) { - my $replace=$1; - my $regexp=$replace; - #$regexp=~s/\|/\\\|/g; - $acchash{'acc.res.'.$short.'.'.$uripath} - =~s/\Q$regexp\E/$replace\|$uricond/; - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}.= - $urifile.':'.$uricond.'&'; - } - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}= - '&'.$urifile.':'.$uricond.'&'; - } - } - } - } + foreach (split(/\,/,$hash{$_})) { + my $resid=$_; + my $uri=$hash{'src_'.$resid}; + $uri=~s/^\/adm\/wrapper//; + $uri=&Apache::lonnet::declutter($uri); + my @uriparts=split(/\//,$uri); + my $urifile=$uriparts[$#uriparts]; + $#uriparts--; + my $uripath=join('/',@uriparts); + if ($uripath) { + my $uricond='0'; + if (defined($hash{'conditions_'.$resid})) { + $uricond=$captured{$hash{'conditions_'.$resid}}; + } + if (defined($acchash{'acc.res.'.$short.'.'.$uripath})) { + if ($acchash{'acc.res.'.$short.'.'.$uripath}=~ + /(\&\Q$urifile\E\:[^\&]*)/) { + my $replace=$1; + my $regexp=$replace; + #$regexp=~s/\|/\\\|/g; + $acchash{'acc.res.'.$short.'.'.$uripath} + =~s/\Q$regexp\E/$replace\|$uricond/; + } else { + $acchash{'acc.res.'.$short.'.'.$uripath}.= + $urifile.':'.$uricond.'&'; + } + } else { + $acchash{'acc.res.'.$short.'.'.$uripath}= + '&'.$urifile.':'.$uricond.'&'; + } + } + } + } } $acchash{'acc.res.'.$short.'.'}='&:0&'; my $courseuri=$uri; @@ -505,11 +504,11 @@ sub hiddenurls { $hash{'randomout_'.$currentrids[$k]}=1; my ($mapid,$resid)=split(/\./,$currentrids[$k]); $randomoutentry.='&'. - &Apache::lonnet::symbclean( - &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). - '___'.$resid.'___'. - &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]}) - ).'&'; + &Apache::lonnet::symbclean( + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]}) + ).'&'; } } } @@ -519,9 +518,9 @@ sub hiddenurls { my ($mapid,$resid)=split(/\./,$rid); $randomoutentry.='&'. &Apache::lonnet::symbclean( - &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). + &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). '___'.$resid.'___'. - &Apache::lonnet::declutter($hash{'src_'.$rid}) + &Apache::lonnet::declutter($hash{'src_'.$rid}) ).'&'; } # --------------------------------------- append randomout entry to environment @@ -533,89 +532,89 @@ sub hiddenurls { # ---------------------------------------------------- Read map and all submaps sub readmap { - my $short=shift; - $short=~s/^\///; - my %cenv=&Apache::lonnet::coursedescription($short); - my $fn=$cenv{'fn'}; - my $uri; - $short=~s/\//\_/g; - unless ($uri=$cenv{'url'}) { - &Apache::lonnet::logthis("WARNING: ". - "Could not load course $short."); - return 'No course data available.'; - } - @cond=('true:normal'); - unlink($fn.'.db'); - unlink($fn.'_symb.db'); - unlink($fn.'.state'); - unlink($fn.'parms.db'); - undef %randompick; - undef %hiddenurl; - undef %encurl; - $retfurl=''; - if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && - (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { - %hash=(); - %parmhash=(); - $errtext=''; - $pc=0; - &processversionfile(%cenv); - my $furi=&Apache::lonnet::clutter($uri); - $hash{'src_0.0'}=&versiontrack($furi); - $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); - $hash{'ids_'.$furi}='0.0'; - $hash{'is_map_0.0'}=1; - loadmap($uri); - if (defined($hash{'map_start_'.$uri})) { - &Apache::lonnet::appenv("request.course.id" => $short, - "request.course.fn" => $fn, - "request.course.uri" => $uri); - &traceroute('0',$hash{'map_start_'.$uri},'&'); - &accinit($uri,$short,$fn); - &hiddenurls(); - } + my $short=shift; + $short=~s/^\///; + my %cenv=&Apache::lonnet::coursedescription($short); + my $fn=$cenv{'fn'}; + my $uri; + $short=~s/\//\_/g; + unless ($uri=$cenv{'url'}) { + &Apache::lonnet::logthis("WARNING: ". + "Could not load course $short."); + return 'No course data available.'; + } + @cond=('true:normal'); + unlink($fn.'.db'); + unlink($fn.'_symb.db'); + unlink($fn.'.state'); + unlink($fn.'parms.db'); + undef %randompick; + undef %hiddenurl; + undef %encurl; + $retfurl=''; + if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && + (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { + %hash=(); + %parmhash=(); + $errtext=''; + $pc=0; + &processversionfile(%cenv); + my $furi=&Apache::lonnet::clutter($uri); + $hash{'src_0.0'}=&versiontrack($furi); + $hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); + $hash{'ids_'.$furi}='0.0'; + $hash{'is_map_0.0'}=1; + loadmap($uri); + if (defined($hash{'map_start_'.$uri})) { + &Apache::lonnet::appenv("request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $uri); + &traceroute('0',$hash{'map_start_'.$uri},'&'); + &accinit($uri,$short,$fn); + &hiddenurls(); + } # ------------------------------------------------------- Put versions into src - foreach (keys %hash) { - if ($_=~/^src\_/) { - $hash{$_}=&putinversion($hash{$_}); + foreach (keys %hash) { + if ($_=~/^src\_/) { + $hash{$_}=&putinversion($hash{$_}); + } } - } # ---------------------------------------------------------------- Encrypt URLs - foreach (keys %encurl) { -# $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_}); - $hash{'encrypted_'.$_}=1; - } + foreach (keys %encurl) { +# $hash{'src_'.$_}=&Apache::lonenc::encrypted($hash{'src_'.$_}); + $hash{'encrypted_'.$_}=1; + } # ----------------------------------------------- Close hashes to finally store # --------------------------------- Routine must pass this point, no early outs - unless ((untie(%hash)) && (untie(%parmhash))) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn for $uri."); - } + unless ((untie(%hash)) && (untie(%parmhash))) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie coursemap $fn for $uri."); + } # ---------------------------------------------------- Store away initial state - { - my $cfh; - if ($cfh=Apache::File->new(">$fn.state")) { - print $cfh join("\n",@cond); - } else { - &Apache::lonnet::logthis("WARNING: ". - "Could not write statemap $fn for $uri."); - } - } - } else { - &Apache::lonnet::logthis("WARNING: ". - "Could not tie coursemap $fn for $uri."); - } - &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); + { + my $cfh; + if ($cfh=Apache::File->new(">$fn.state")) { + print $cfh join("\n",@cond); + } else { + &Apache::lonnet::logthis("WARNING: ". + "Could not write statemap $fn for $uri."); + } + } + } else { + &Apache::lonnet::logthis("WARNING: ". + "Could not tie coursemap $fn for $uri."); + } + &Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext); # ------------------------------------------------- Check for critical messages my @what=&Apache::lonnet::dump('critical',$ENV{'user.domain'}, - $ENV{'user.name'}); + $ENV{'user.name'}); if ($what[0]) { if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { $retfurl='/adm/email?critical=display'; } } - return ($retfurl,$errtext); + return ($retfurl,$errtext); } # ------------------------------------------------------- Evaluate state string