--- rat/lonuserstate.pm 2004/04/05 18:25:08 1.72 +++ rat/lonuserstate.pm 2008/03/12 02:45:50 1.128 @@ -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.72 2004/04/05 18:25:08 raeburn Exp $ +# $Id: lonuserstate.pm,v 1.128 2008/03/12 02:45:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,16 +31,19 @@ package Apache::lonuserstate; # ------------------------------------------------- modules used by this module use strict; -use Apache::Constants qw(:common :http); -use Apache::File; use HTML::TokeParser; -use Apache::lonnet(); +use Apache::lonnet; +use Apache::lonlocal; use Apache::loncommon(); use GDBM_File; use Apache::lonmsg; use Safe; use Safe::Hole; use Opcode; +use Apache::lonenc; +use Fcntl qw(:flock); +use LONCAPA; + # ---------------------------------------------------- Globals for this package @@ -49,9 +52,13 @@ my %hash; # The big tied hash my %parmhash;# The hash with the parameters my @cond; # Array with all of the conditions my $errtext; # variable with all errors -my $retfurl; # variable with the very first URL in the course +my $retfrid; # variable with the very first RID in the course +my $retfurl; # first URL my %randompick; # randomly picked resources my %randompickseed; # optional seed for randomly picking resources +my %randomorder; # maps to order contents randomly +my %encurl; # URLs in this folder are supposed to be encrypted +my %hiddenurl; # this URL (or complete folder) is supposed to be hidden # ----------------------------------- Remove version from URL and store in hash @@ -71,6 +78,7 @@ sub versiontrack { sub putinversion { my $uri=shift; + my $key=$env{'request.course.id'}.'_'.&Apache::lonnet::clutter($uri); if ($hash{'version_'.$uri}) { my $version=$hash{'version_'.$uri}; if ($version eq 'mostrecent') { return $uri; } @@ -79,6 +87,7 @@ sub putinversion { { return $uri; } $uri=~s/\.(\w+)$/\.$version\.$1/; } + &Apache::lonnet::do_cache_new('courseresversion',$key,&Apache::lonnet::declutter($uri),600); return $uri; } @@ -89,18 +98,22 @@ sub processversionfile { my %versions=&Apache::lonnet::dump('resourceversions', $cenv{'domain'}, $cenv{'num'}); - foreach (keys %versions) { - if ($_=~/^error\:/) { return; } - $hash{'version_'.$_}=$versions{$_}; + foreach my $ver (keys(%versions)) { + if ($ver=~/^error\:/) { return; } + $hash{'version_'.$ver}=$versions{$ver}; } } # --------------------------------------------------------- Loads map from disk sub loadmap { - my $uri=shift; - if ($hash{'map_pc_'.$uri}) { return OK; } - + my ($uri,$parent_rid)=@_; + if ($hash{'map_pc_'.$uri}) { + $errtext.='

'. + &mt('Multiple use of sequence/page [_1]! The course will not function properly.',''.$uri.''). + '

'; + return; + } $pc++; my $lpc=$pc; $hash{'map_pc_'.$uri}=$lpc; @@ -113,257 +126,374 @@ sub loadmap { unless (($fn=~/\.sequence$/) || ($fn=~/\.page$/)) { - $errtext.="Invalid map: $fn\n"; - return OK; + $errtext.=&mt("
Invalid map: [_1]",$fn); + return; } my $instr=&Apache::lonnet::getfile($fn); - unless ($instr eq -1) { + if ($instr eq -1) { + $errtext.=&mt('
Map not loaded: The file [_1] does not exist.',$fn); + return; + } # Successfully got file, parse it - my $parser = HTML::TokeParser->new(\$instr); - my $token; - - my $linkpc=0; + my $parser = HTML::TokeParser->new(\$instr); + $parser->attr_encoded(1); + # first get all parameters + while (my $token = $parser->get_token) { + next if ($token->[0] ne 'S'); + if ($token->[1] eq 'param') { + &parse_param($token,$lpc); + } + } + #reset parser + $parser = HTML::TokeParser->new(\$instr); + $parser->attr_encoded(1); + + my $linkpc=0; + + $fn=~/\.(\w+)$/; + + $hash{'map_type_'.$lpc}=$1; + + my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i); + + my @map_ids; + while (my $token = $parser->get_token) { + next if ($token->[0] ne 'S'); + if ($token->[1] eq 'resource') { + push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri)); + } elsif ($token->[1] eq 'link' && !$randomize) { +# ----------------------------------------------------------------------- Links + &make_link(++$linkpc,$lpc,$token->[2]->{'to'}, + $token->[2]->{'from'}, + $token->[2]->{'condition'}); + } elsif ($token->[1] eq 'condition' && !$randomize) { + &parse_condition($token,$lpc); + } + } - $fn=~/\.(\w+)$/; + if ($randomize) { + if (!$env{'request.role.adv'}) { + my $seed; + if (defined($randompickseed{$parent_rid})) { + $seed = $randompickseed{$parent_rid}; + } else { + my ($mapid,$resid)=split(/\./,$parent_rid); + my $symb= + &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, + $resid,$hash{'src_'.$parent_rid}); + + $seed = $symb; + } + + my $rndseed=&Apache::lonnet::rndseed($seed); + &Apache::lonnet::setup_random_from_rndseed($rndseed); + @map_ids=&Math::Random::random_permutation(@map_ids); + } + my $from = shift(@map_ids); + my $from_rid = $lpc.'.'.$from; + $hash{'map_start_'.$uri} = $from_rid; + $hash{'type_'.$from_rid}='start'; + + while (my $to = shift(@map_ids)) { + &make_link(++$linkpc,$lpc,$to,$from); + my $to_rid = $lpc.'.'.$to; + $hash{'type_'.$to_rid}='normal'; + $from = $to; + $from_rid = $to_rid; + } - $hash{'map_type_'.$lpc}=$1; + $hash{'map_finish_'.$uri}= $from_rid; + $hash{'type_'.$from_rid}='finish'; + } - while ($token = $parser->get_token) { - if ($token->[0] eq 'S') { - if ($token->[1] eq 'resource') { -# -------------------------------------------------------------------- Resource + $parser = HTML::TokeParser->new(\$instr); + $parser->attr_encoded(1); + # last parse out the mapalias params so as to ignore anything + # refering to non-existant resources + while (my $token = $parser->get_token) { + next if ($token->[0] ne 'S'); + if ($token->[1] eq 'param') { + &parse_mapalias_param($token,$lpc); + } + } +} - my $rid=$lpc.'.'.$token->[2]->{'id'}; - $hash{'kind_'.$rid}='res'; - $hash{'title_'.$rid}=$token->[2]->{'title'}; - my $turi=&versiontrack($token->[2]->{'src'}); - if ($token->[2]->{'version'}) { - unless ($hash{'version_'.$turi}) { - $hash{'version_'.$turi}=$1; - } - } - &Apache::lonnet::do_cache(\%Apache::lonnet::titlecache, - &Apache::lonnet::encode_symb($uri,$token->[2]->{'id'}, - $turi), - $token->[2]->{'title'},'title'); - unless ($ispage) { - $turi=~/\.(\w+)$/; - my $embstyle=&Apache::loncommon::fileembstyle($1); - if ($token->[2]->{'external'} eq 'true') { # external - $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; - } elsif ($turi=~/^\/*uploaded\//) { # uploaded - if (($embstyle eq 'img') || ($embstyle eq 'emb') - || ($embstyle eq 'ssi')) { - unless ($turi =~/\.page$/) { - $turi='/adm/wrapper'.$turi; - } - } elsif ($turi!~/\.(sequence|page)$/) { - $turi='/adm/coursedocs/showdoc'.$turi; - } - } elsif ($turi=~/\S/) { # normal non-empty internal resource - my $mapdir=$uri; - $mapdir=~s/[^\/]+$//; - $turi=&Apache::lonnet::hreflocation($mapdir,$turi); - if (($embstyle eq 'img') || ($embstyle eq 'emb')) { - $turi='/adm/wrapper'.$turi; - } - } - } +# -------------------------------------------------------------------- Resource +sub parse_resource { + my ($token,$lpc,$ispage,$uri) = @_; + if ($token->[2]->{'type'} eq 'zombie') { next; } + my $rid=$lpc.'.'.$token->[2]->{'id'}; + + $hash{'kind_'.$rid}='res'; + $hash{'title_'.$rid}=$token->[2]->{'title'}; + my $turi=&versiontrack($token->[2]->{'src'}); + if ($token->[2]->{'version'}) { + unless ($hash{'version_'.$turi}) { + $hash{'version_'.$turi}=$1; + } + } + my $title=$token->[2]->{'title'}; + $title=~s/\&colon\;/\:/gs; +# my $symb=&Apache::lonnet::encode_symb($uri, +# $token->[2]->{'id'}, +# $turi); +# &Apache::lonnet::do_cache_new('title',$symb,$title); + unless ($ispage) { + $turi=~/\.(\w+)$/; + my $embstyle=&Apache::loncommon::fileembstyle($1); + if ($token->[2]->{'external'} eq 'true') { # external + $turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; + } elsif ($turi=~/^\/*uploaded\//) { # uploaded + if (($embstyle eq 'img') + || ($embstyle eq 'emb') + || ($embstyle eq 'wrp')) { + $turi='/adm/wrapper'.$turi; + } elsif ($embstyle eq 'ssi') { + #do nothing with these + } elsif ($turi!~/\.(sequence|page)$/) { + $turi='/adm/coursedocs/showdoc'.$turi; + } + } elsif ($turi=~/\S/) { # normal non-empty internal resource + my $mapdir=$uri; + $mapdir=~s/[^\/]+$//; + $turi=&Apache::lonnet::hreflocation($mapdir,$turi); + if (($embstyle eq 'img') + || ($embstyle eq 'emb') + || ($embstyle eq 'wrp')) { + $turi='/adm/wrapper'.$turi; + } + } + } # Store reverse lookup, remove query string - my $idsuri=$turi; - $idsuri=~s/\?.+$//; - if (defined($hash{'ids_'.$idsuri})) { - $hash{'ids_'.$idsuri}.=','.$rid; - } else { - $hash{'ids_'.$idsuri}=''.$rid; - } - - if - ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { - $turi.='?register=1'; - } - - $hash{'src_'.$rid}=$turi; - - if ($token->[2]->{'external'} eq 'true') { - $hash{'ext_'.$rid}='true:'; - } else { - $hash{'ext_'.$rid}='false:'; - } - if ($token->[2]->{'type'}) { - $hash{'type_'.$rid}=$token->[2]->{'type'}; - if ($token->[2]->{'type'} eq 'start') { - $hash{'map_start_'.$uri}="$rid"; - } - if ($token->[2]->{'type'} eq 'finish') { - $hash{'map_finish_'.$uri}="$rid"; - } - } else { - $hash{'type_'.$rid}='normal'; - } - - if (($turi=~/\.sequence$/) || - ($turi=~/\.page$/)) { - $hash{'is_map_'.$rid}=1; - &loadmap($turi); - } - - } elsif ($token->[1] eq 'condition') { -# ------------------------------------------------------------------- Condition - - my $rid=$lpc.'.'.$token->[2]->{'id'}; + my $idsuri=$turi; + $idsuri=~s/\?.+$//; + if (defined($hash{'ids_'.$idsuri})) { + $hash{'ids_'.$idsuri}.=','.$rid; + } else { + $hash{'ids_'.$idsuri}=''.$rid; + } + + if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { + $turi.='?register=1'; + } + + $hash{'src_'.$rid}=$turi; + + if ($token->[2]->{'external'} eq 'true') { + $hash{'ext_'.$rid}='true:'; + } else { + $hash{'ext_'.$rid}='false:'; + } + if ($token->[2]->{'type'}) { + $hash{'type_'.$rid}=$token->[2]->{'type'}; + if ($token->[2]->{'type'} eq 'start') { + $hash{'map_start_'.$uri}="$rid"; + } + if ($token->[2]->{'type'} eq 'finish') { + $hash{'map_finish_'.$uri}="$rid"; + } + } else { + $hash{'type_'.$rid}='normal'; + } + + if (($turi=~/\.sequence$/) || + ($turi=~/\.page$/)) { + $hash{'is_map_'.$rid}=1; + &loadmap($turi,$rid); + } + return $token->[2]->{'id'}; +} - $hash{'kind_'.$rid}='cond'; - $cond[$#cond+1]=$token->[2]->{'value'}; - $hash{'condid_'.$rid}=$#cond; - if ($token->[2]->{'type'}) { - $cond[$#cond].=':'.$token->[2]->{'type'}; - } else { - $cond[$#cond].=':normal'; - } +sub make_link { + my ($linkpc,$lpc,$to,$from,$condition) = @_; + + my $linkid=$lpc.'.'.$linkpc; + my $goesto=$lpc.'.'.$to; + my $comesfrom=$lpc.'.'.$from; + my $undercond=0; + + if ($condition) { + $undercond=$lpc.'.'.$condition; + } + + $hash{'goesto_'.$linkid}=$goesto; + $hash{'comesfrom_'.$linkid}=$comesfrom; + $hash{'undercond_'.$linkid}=$undercond; - } elsif ($token->[1] eq 'link') { -# ----------------------------------------------------------------------- Links + if (defined($hash{'to_'.$comesfrom})) { + $hash{'to_'.$comesfrom}.=','.$linkid; + } else { + $hash{'to_'.$comesfrom}=''.$linkid; + } + if (defined($hash{'from_'.$goesto})) { + $hash{'from_'.$goesto}.=','.$linkid; + } else { + $hash{'from_'.$goesto}=''.$linkid; + } +} - $linkpc++; - my $linkid=$lpc.'.'.$linkpc; +# ------------------------------------------------------------------- Condition +sub parse_condition { + my ($token,$lpc) = @_; + my $rid=$lpc.'.'.$token->[2]->{'id'}; + + $hash{'kind_'.$rid}='cond'; + + my $condition = $token->[2]->{'value'}; + $condition =~ s/[\n\r]+/ /gs; + push(@cond, $condition); + $hash{'condid_'.$rid}=$#cond; + if ($token->[2]->{'type'}) { + $cond[$#cond].=':'.$token->[2]->{'type'}; + } else { + $cond[$#cond].=':normal'; + } +} - my $goesto=$lpc.'.'.$token->[2]->{'to'}; - my $comesfrom=$lpc.'.'.$token->[2]->{'from'}; - my $undercond=0; - - if ($token->[2]->{'condition'}) { - $undercond=$lpc.'.'.$token->[2]->{'condition'}; - } - - $hash{'goesto_'.$linkid}=$goesto; - $hash{'comesfrom_'.$linkid}=$comesfrom; - $hash{'undercond_'.$linkid}=$undercond; - - if (defined($hash{'to_'.$comesfrom})) { - $hash{'to_'.$comesfrom}.=','.$linkid; - } else { - $hash{'to_'.$comesfrom}=''.$linkid; - } - if (defined($hash{'from_'.$goesto})) { - $hash{'from_'.$goesto}.=','.$linkid; - } else { - $hash{'from_'.$goesto}=''.$linkid; - } - } elsif ($token->[1] eq 'param') { # ------------------------------------------------------------------- Parameter - my $referid=$lpc.'.'.$token->[2]->{'to'}; - my $name=$token->[2]->{'name'}; - my $part; - if ($name=~/^parameter_(.*)_/) { - $part=$1; - } else { - $part=0; - } - $name=~s/^.*_([^_]*)$/$1/; - my $newparam= - &Apache::lonnet::escape($token->[2]->{'type'}).':'. - &Apache::lonnet::escape($part.'.'.$name).'='. - &Apache::lonnet::escape($token->[2]->{'value'}); - if (defined($hash{'param_'.$referid})) { - $hash{'param_'.$referid}.='&'.$newparam; - } else { - $hash{'param_'.$referid}=''.$newparam; - } - if ($token->[2]->{'name'} eq 'parameter_mapalias') { - $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; - } - if ($token->[2]->{'name'} eq 'parameter_randompick') { - $randompick{$referid}=$token->[2]->{'value'}; - } - if ($token->[2]->{'name'} eq 'parameter_randompickseed') { - $randompick{$referid}=$token->[2]->{'value'}; - } - } - - } - } - +sub parse_param { + my ($token,$lpc) = @_; + my $referid=$lpc.'.'.$token->[2]->{'to'}; + my $name=$token->[2]->{'name'}; + my $part; + if ($name=~/^parameter_(.*)_/) { + $part=$1; } else { - $errtext.='Map not loaded: The file does not exist. '; + $part=0; + } + $name=~s/^.*_([^_]*)$/$1/; + my $newparam= + &escape($token->[2]->{'type'}).':'. + &escape($part.'.'.$name).'='. + &escape($token->[2]->{'value'}); + if (defined($hash{'param_'.$referid})) { + $hash{'param_'.$referid}.='&'.$newparam; + } else { + $hash{'param_'.$referid}=''.$newparam; + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { + $randompick{$referid}=$token->[2]->{'value'}; + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { + $randompickseed{$referid}=$token->[2]->{'value'}; + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { + $randomorder{$referid}=$token->[2]->{'value'}; + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { + if ($token->[2]->{'value'}=~/^yes$/i) { + $encurl{$referid}=1; + } + } + if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { + if ($token->[2]->{'value'}=~/^yes$/i) { + $hiddenurl{$referid}=1; + } + } +} + +sub parse_mapalias_param { + my ($token,$lpc) = @_; + my $referid=$lpc.'.'.$token->[2]->{'to'}; + return if (!exists($hash{'src_'.$referid})); + + if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { + &count_mapalias($token->[2]->{'value'},$referid); + $hash{'mapalias_'.$token->[2]->{'value'}}=$referid; } } # --------------------------------------------------------- Simplify expression sub simplify { - my $expression=shift; + my $expression=shift; +# (0&1) = 1 + $expression=~s/\(0\&([_\.\d]+)\)/$1/g; # (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 sub traceroute { - my ($sofar,$rid,$beenhere)=@_; - $sofar=simplify($sofar); - unless ($beenhere=~/\&$rid\&/) { - $beenhere.=$rid.'&'; - if (($retfurl eq '') && ($hash{'src_'.$rid}) - && ($hash{'src_'.$rid}!~/\.sequence$/)) { - my ($mapid,$resid)=split(/\./,$rid); - $retfurl=$hash{'src_'.$rid}. - (($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='. - &Apache::lonnet::symbclean( - &Apache::lonnet::declutter($hash{'map_id_'.$mapid}). - '___'.$resid.'___'. - &Apache::lonnet::declutter($hash{'src_'.$rid})); - } - if (defined($hash{'conditions_'.$rid})) { - $hash{'conditions_'.$rid}=simplify( + my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; + my $newsofar=$sofar=simplify($sofar); + unless ($beenhere=~/\&\Q$rid\E\&/) { + $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; + } + if (!$hdnflag && lc($hidden) eq 'no') { + delete($hiddenurl{$rid}); + } + + my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); + if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } + if (($retfrid eq '') && ($hash{'src_'.$rid}) + && ($hash{'src_'.$rid}!~/\.sequence$/)) { + $retfrid=$rid; + } + if (defined($hash{'conditions_'.$rid})) { + $hash{'conditions_'.$rid}=simplify( '('.$hash{'conditions_'.$rid}.')|('.$sofar.')'); - } else { - $hash{'conditions_'.$rid}=$sofar; - } - if (defined($hash{'is_map_'.$rid})) { - if (defined($hash{'map_start_'.$hash{'src_'.$rid}})) { - &traceroute($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},'&'); - if (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) { - $sofar= - $hash{'conditions_'.$hash{'map_finish_'.$hash{'src_'.$rid}}}; - } - } - } - if (defined($hash{'to_'.$rid})) { - foreach (split(/\,/,$hash{'to_'.$rid})) { + } else { + $hash{'conditions_'.$rid}=$sofar; + } + + # if the expression is just the 0th condition keep it + # otherwise leave a pointer to this condition expression + $newsofar = ($sofar eq '0') ? $sofar : '_'.$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}}, + $beenhere, + $encflag || $encurl{$rid}, + $hdnflag || $hiddenurl{$rid}); + } + } + if (defined($hash{'to_'.$rid})) { + foreach my $id (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 ($hash{'undercond_'.$id}) { + if (defined($hash{'condid_'.$hash{'undercond_'.$id}})) { + $further=simplify('('.'_'.$rid.')&('. + $hash{'condid_'.$hash{'undercond_'.$id}}.')'); + } else { + $errtext.=&mt('
Undefined condition ID: [_1]',$hash{'undercond_'.$id}); + } } - &traceroute($further,$hash{'goesto_'.$_},$beenhere); - } - } + $newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, + $encflag,$hdnflag); + } + } } + return $newsofar; } # ------------------------------ Cascading conditions, quick access, parameters @@ -374,97 +504,90 @@ sub accinit { my %captured=(); 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); - } - } - } - 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/$regexp/$replace\|$uricond/; - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}.= - $urifile.':'.$uricond.'&'; - } - } else { - $acchash{'acc.res.'.$short.'.'.$uripath}= - '&'.$urifile.':'.$uricond.'&'; - } - } - } - } + foreach my $key (keys(%hash)) { + if ($key=~/^conditions/) { + my $expr=$hash{$key}; + # try to find and factor out common sub-expressions + foreach my $sub ($expr=~m/(\(\([_\.\d]+(?:\&[_\.\d]+)+\)(?:\|\([_\.\d]+(?:\&[_\.\d]+)+\))+\))/g) { + my $orig=$sub; + + my ($factor) = ($sub=~/\(\(([_\.\d]+\&(:?[_\.\d]+\&)*)(?:[_\.\d]+\&*)+\)(?:\|\(\1(?:[_\.\d]+\&*)+\))+\)/); + next if (!defined($factor)); + + $sub=~s/\Q$factor\E//g; + $sub=~s/^\(/\($factor\(/; + $sub.=')'; + $sub=simplify($sub); + $expr=~s/\Q$orig\E/$sub/; + } + $hash{$key}=$expr; + unless (defined($captured{$expr})) { + $condcounter++; + $captured{$expr}=$condcounter; + $acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr; + } + } elsif ($key=~/^param_(\d+)\.(\d+)/) { + my $prefix=&Apache::lonnet::encode_symb($hash{'map_id_'.$1},$2, + $hash{'src_'.$1.'.'.$2}); + foreach my $param (split(/\&/,$hash{$key})) { + my ($typename,$value)=split(/\=/,$param); + my ($type,$name)=split(/\:/,$typename); + $parmhash{$prefix.'.'.&unescape($name)}= + &unescape($value); + $parmhash{$prefix.'.'.&unescape($name).'.type'}= + &unescape($type); + } + } + } + foreach my $key (keys(%hash)) { + if ($key=~/^ids/) { + foreach my $resid (split(/\,/,$hash{$key})) { + my $uri=$hash{'src_'.$resid}; + my ($uripath,$urifile) = + &Apache::lonnet::split_uri_for_cond($uri); + 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; $courseuri=~s/^\/res\///; &Apache::lonnet::delenv('(acc\.|httpref\.)'); - &Apache::lonnet::appenv(%acchash, - "request.course.id" => $short, - "request.course.fn" => $fn, - "request.course.uri" => $courseuri); + &Apache::lonnet::appenv(\%acchash); } -# ------------------------------------- Selectively delete from randompick maps +# ---------------- Selectively delete from randompick maps and hidden url parms -sub pickrandom { +sub hiddenurls { my $randomoutentry=''; foreach my $rid (keys %randompick) { my $rndpick=$randompick{$rid}; my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}}; # ------------------------------------------- put existing resources into array my @currentrids=(); - foreach (sort(keys(%hash))) { - if ($_=~/^src_($mpc\.\d+)/) { + foreach my $key (sort(keys(%hash))) { + if ($key=~/^src_($mpc\.\d+)/) { if ($hash{'src_'.$1}) { push @currentrids, $1; } } } @@ -490,135 +613,248 @@ sub pickrandom { $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::encode_symb($hash{'map_id_'.$mapid}, + $resid, + $hash{'src_'.$currentrids[$k]} + ).'&'; } } } +# ------------------------------ take care of explicitly hidden urls or folders + foreach my $rid (keys %hiddenurl) { + $hash{'randomout_'.$rid}=1; + my ($mapid,$resid)=split(/\./,$rid); + $randomoutentry.='&'. + &Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid, + $hash{'src_'.$rid}).'&'; + } +# --------------------------------------- append randomout entry to environment if ($randomoutentry) { - &Apache::lonnet::appenv('acc.randomout' => $randomoutentry); + &Apache::lonnet::appenv({'acc.randomout' => $randomoutentry}); } } # ---------------------------------------------------- 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; - $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})) { - &traceroute('0',$hash{'map_start_'.$uri},'&'); - &accinit($uri,$short,$fn); - &pickrandom(); - } + my $short=shift; + $short=~s/^\///; + my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); + my $fn=$cenv{'fn'}; + my $uri; + $short=~s/\//\_/g; + unless ($uri=$cenv{'url'}) { + &Apache::lonnet::logthis("WARNING: ". + "Could not load course $short."); + return ('',&mt('No course data available.'));; + } + @cond=('true:normal'); + + open(LOCKFILE,">$fn.db.lock"); + my $lock=0; + if (flock(LOCKFILE,LOCK_EX|LOCK_NB)) { + $lock=1; + unlink($fn.'.db'); + unlink($fn.'_symb.db'); + unlink($fn.'.state'); + unlink($fn.'parms.db'); + } + undef %randompick; + undef %hiddenurl; + undef %encurl; + $retfrid=''; + if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && + (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { + %hash=(); + %parmhash=(); + $errtext=''; + $pc=0; + &clear_mapalias_count(); + &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,'0.0'); + if (defined($hash{'map_start_'.$uri})) { + &Apache::lonnet::appenv({"request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $uri}); + $env{'request.course.id'}=$short; + &traceroute('0',$hash{'map_start_'.$uri},'&'); + &accinit($uri,$short,$fn); + &hiddenurls(); + } + $errtext .= &get_mapalias_errors(); # ------------------------------------------------------- Put versions into src - foreach (keys %hash) { - if ($_=~/^src\_/) { - $hash{$_}=&putinversion($hash{$_}); - } - } - unless ((untie(%hash)) && (untie(%parmhash))) { - &Apache::lonnet::logthis("WARNING: ". - "Could not untie coursemap $fn for $uri."); - } - { - 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); + foreach my $key (keys(%hash)) { + if ($key=~/^src_/) { + $hash{$key}=&putinversion($hash{$key}); + } elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { + my ($type, $url) = ($1,$2); + my $value = $hash{$key}; + $hash{$type.&putinversion($url)}=$value; + } + } +# ---------------------------------------------------------------- Encrypt URLs + foreach my $id (keys(%encurl)) { +# $hash{'src_'.$id}=&Apache::lonenc::encrypted($hash{'src_'.$id}); + $hash{'encrypted_'.$id}=1; + } +# ----------------------------------------------- Close hashes to finally store +# --------------------------------- Routine must pass this point, no early outs + $hash{'first_rid'}=$retfrid; + my ($mapid,$resid)=split(/\./,$retfrid); + $hash{'first_mapurl'}=$hash{'map_id_'.$mapid}; + my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid}); + $retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb }); + if ($hash{'encrypted_'.$retfrid}) { + $retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F')); + } + $hash{'first_url'}=$retfurl; + unless ((untie(%hash)) && (untie(%parmhash))) { + &Apache::lonnet::logthis("WARNING: ". + "Could not untie coursemap $fn for $uri."); + } +# ---------------------------------------------------- Store away initial state + { + my $cfh; + if (open($cfh,">$fn.state")) { + print $cfh join("\n",@cond); + } else { + &Apache::lonnet::logthis("WARNING: ". + "Could not write statemap $fn for $uri."); + } + } + flock(LOCKFILE,LOCK_UN); + close(LOCKFILE); + } else { + # if we are here it is likely because we are already trying to + # initialize the course in another child, busy wait trying to + # tie the hashes for the next 90 seconds, if we succeed forward + # them on to navmaps, if we fail, throw up the Could not init + # course screen + if ($lock) { + # Got the lock but not the DB files + flock(LOCKFILE,LOCK_UN); + } + untie(%hash); + untie(%parmhash); + &Apache::lonnet::logthis("WARNING: ". + "Could not tie coursemap $fn for $uri."); + my $i=0; + while($i<90) { + $i++; + sleep(1); + if (flock(LOCKFILE,LOCK_EX|LOCK_NB) && + (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640))) { + if (tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_READER(),0640)) { + $retfurl='/adm/navmaps'; + &Apache::lonnet::appenv({"request.course.id" => $short, + "request.course.fn" => $fn, + "request.course.uri" => $uri}); + untie(%hash); + untie(%parmhash); + last; + } + } + untie(%hash); + untie(%parmhash); + } + flock(LOCKFILE,LOCK_UN); + close(LOCKFILE); + } + &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'}); + my @what=&Apache::lonnet::dump('critical',$env{'user.domain'}, + $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 sub evalstate { - - my $fn=$ENV{'request.course.fn'}.'.state'; - my $state='2'; + my $fn=$env{'request.course.fn'}.'.state'; + my $state=''; if (-e $fn) { - my @conditions=(); - { - my $fh=Apache::File->new($fn); - @conditions=<$fh>; - } - my $safeeval = new Safe; - my $safehole = new Safe::Hole; - $safeeval->permit("entereval"); - $safeeval->permit(":base_math"); - $safeeval->deny(":base_io"); - $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); - foreach (@conditions) { - my $line=$_; - chomp($line); - my ($condition,$weight)=split(/\:/,$_); - if ($safeeval->reval($condition)) { - if ($weight eq 'force') { - $state.='3'; - } else { - $state.='2'; - } - } else { - if ($weight eq 'stop') { - $state.='0'; - } else { - $state.='1'; - } - } - } + my @conditions=(); + { + open(my $fh,"<$fn"); + @conditions=<$fh>; + close($fh); + } + my $safeeval = new Safe; + my $safehole = new Safe::Hole; + $safeeval->permit("entereval"); + $safeeval->permit(":base_math"); + $safeeval->deny(":base_io"); + $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); + foreach my $line (@conditions) { + chomp($line); + my ($condition,$weight)=split(/\:/,$line); + if ($safeeval->reval($condition)) { + if ($weight eq 'force') { + $state.='3'; + } else { + $state.='2'; + } + } else { + if ($weight eq 'stop') { + $state.='0'; + } else { + $state.='1'; + } + } + } } - &Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state); + &Apache::lonnet::appenv({'user.state.'.$env{'request.course.id'} => $state}); return $state; } +{ + my %mapalias_cache; + sub count_mapalias { + my ($value,$resid) = @_; + push(@{ $mapalias_cache{$value} }, $resid); + } + + sub get_mapalias_errors { + my $error_text; + foreach my $mapalias (sort(keys(%mapalias_cache))) { + next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); + my $count; + my $which = + join('
  • ', + map { + my $id = $_; + if (exists($hash{'src_'.$id})) { + $count++; + } + my ($mapid) = split(/\./,$id); + &mt('Resource "[_1]"
    in Map "[_2]"', + $hash{'title_'.$id}, + $hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); + } (@{ $mapalias_cache{$mapalias} })); + next if ($count < 2); + $error_text .= '
    '. + &mt('Error: Found the mapalias "[_1]" defined multiple times.', + $mapalias). + '
    '; + } + &clear_mapalias_count(); + return $error_text; + } + sub clear_mapalias_count { + undef(%mapalias_cache); + } +} 1; __END__ 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.