--- loncom/lonnet/perl/lonnet.pm 2006/02/07 17:30:00 1.683.2.15 +++ loncom/lonnet/perl/lonnet.pm 2006/06/05 20:10:20 1.683.2.22 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683.2.15 2006/02/07 17:30:00 albertel Exp $ +# $Id: lonnet.pm,v 1.683.2.22 2006/06/05 20:10:20 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -272,6 +272,8 @@ sub transfer_profile_to_env { for ($envi=0;$envi<=$#profile;$envi++) { chomp($profile[$envi]); my ($envname,$envvalue)=split(/=/,$profile[$envi],2); + $envname=&unescape($envname); + $envvalue=&unescape($envvalue); $env{$envname} = $envvalue; if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { if ($time < time-300) { @@ -324,6 +326,8 @@ sub appenv { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { my ($name,$value)=split(/=/,$oldenv[$i],2); + $name=&unescape($name); + $value=&unescape($value); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -336,7 +340,7 @@ sub appenv { } my $newname; foreach $newname (keys %newenv) { - print $fh "$newname=$newenv{$newname}\n"; + print $fh &escape($newname).'='.&escape($newenv{$newname})."\n"; } close($fh); } @@ -348,7 +352,6 @@ sub appenv { sub delenv { my $delthis=shift; - my %newenv=(); if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { &logthis("WARNING: ". "Attempt to delete from environment ".$delthis); @@ -380,12 +383,14 @@ sub delenv { close($fh); return 'error: '.$!; } - foreach (@oldenv) { - if ($_=~/^$delthis/) { - my ($key,undef) = split('=',$_,2); + foreach my $cur_key (@oldenv) { + my $unescaped_cur_key = &unescape($cur_key); + if ($unescaped_cur_key=~/^$delthis/) { + my ($key) = split('=',$cur_key,2); + $key = &unescape($key); delete($env{$key}); } else { - print $fh $_; + print $fh $cur_key; } } close($fh); @@ -948,7 +953,7 @@ sub studentphoto { my ($udom,$unam,$ext) = @_; my $home=&Apache::lonnet::homeserver($unam,$udom); if (defined($env{'request.course.id'})) { - if ($env{'course.'.$env{'request.course.id'}.'.internal.showphotos'}) { + if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) { if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) { return(&retrievestudentphoto($udom,$unam,$ext)); } else { @@ -3435,16 +3440,17 @@ sub allowed { return 'F'; } +sub split_uri_for_cond { + my $uri=&deversion(&declutter(shift)); + my @uriparts=split(/\//,$uri); + my $filename=pop(@uriparts); + my $pathname=join('/',@uriparts); + return ($pathname,$filename); +} # --------------------------------------------------- Is a resource on the map? sub is_on_map { - my $uri=&deversion(&declutter(shift)); - my @uriparts=split(/\//,$uri); - my $filename=$uriparts[$#uriparts]; - my $pathname=$uri; - $pathname=~s|/\Q$filename\E$||; - $pathname=~s/^adm\/wrapper\///; - $pathname=~s/^adm\/coursedocs\/showdoc\///; + my ($pathname,$filename) = &split_uri_for_cond(shift); #Trying to find the conditional for the file my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ /\&\Q$filename\E\:([\d\|]+)\&/); @@ -3722,6 +3728,9 @@ sub auto_photo_permission { my $homeserver = &homeserver($cnum,$cdom); my ($outcome,$perm_reqd,$conditions) = split(/:/,&unescape(&reply('autophotopermission:'.$cdom,$homeserver)),3); + if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) { + return (undef,undef); + } return ($outcome,$perm_reqd,$conditions); } @@ -3732,6 +3741,9 @@ sub auto_checkphotos { my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'. &escape($uname).':'.&escape($pid), $homeserver)); + if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) { + return (undef,undef); + } if ($outcome) { ($result,$resulttype) = split(/:/,$outcome); } @@ -3744,6 +3756,9 @@ sub auto_photochoice { my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'. &escape($cdom), $homeserver))); + if ($update =~ /^(con_lost|unknown_cmd|no_such_host)$/) { + return (undef,undef); + } return ($update,$comment); } @@ -4638,11 +4653,30 @@ sub GetFileTimestamp { # -------------------------------------------------------- Value of a Condition +# gets the value of a specific preevaluated condition +# stored in the string $env{user.state.} +# or looks up a condition reference in the bighash and if if hasn't +# already been evaluated recurses into docondval to get the value of +# the condition, then memoizing it to +# $env{user.state..} sub directcondval { my $number=shift; if (!defined($env{'user.state.'.$env{'request.course.id'}})) { &Apache::lonuserstate::evalstate(); } + if (exists($env{'user.state.'.$env{'request.course.id'}.".$number"})) { + return $env{'user.state.'.$env{'request.course.id'}.".$number"}; + } elsif ($number =~ /^_/) { + my $sub_condition; + if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + $sub_condition=$bighash{'conditions'.$number}; + untie(%bighash); + } + my $value = &docondval($sub_condition); + &appenv('user.state.'.$env{'request.course.id'}.".$number" => $value); + return $value; + } if ($env{'user.state.'.$env{'request.course.id'}}) { return substr($env{'user.state.'.$env{'request.course.id'}},$number,1); } else { @@ -4650,43 +4684,49 @@ sub directcondval { } } +# get the collection of conditions for this resource sub condval { my $condidx=shift; - my $result=0; my $allpathcond=''; - foreach (split(/\|/,$condidx)) { - if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$_})) { - $allpathcond.= - '('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$_}.')|'; - } + foreach my $cond (split(/\|/,$condidx)) { + if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond})) { + $allpathcond.= + '('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond}.')|'; + } } $allpathcond=~s/\|$//; - if ($env{'request.course.id'}) { - if ($allpathcond) { - my $operand='|'; - my @stack; - foreach ($allpathcond=~/(\d+|\(|\)|\&|\|)/g) { - if ($_ eq '(') { - push @stack,($operand,$result) - } elsif ($_ eq ')') { - my $before=pop @stack; - if (pop @stack eq '&') { - $result=$result>$before?$before:$result; - } else { - $result=$result>$before?$result:$before; - } - } elsif (($_ eq '&') || ($_ eq '|')) { - $operand=$_; - } else { - my $new=directcondval($_); - if ($operand eq '&') { - $result=$result>$new?$new:$result; - } else { - $result=$result>$new?$result:$new; - } - } - } - } + return &docondval($allpathcond); +} + +#evaluates an expression of conditions +sub docondval { + my ($allpathcond) = @_; + my $result=0; + if ($env{'request.course.id'} + && defined($allpathcond)) { + my $operand='|'; + my @stack; + foreach my $chunk ($allpathcond=~/(\d+|_\d+\.\d+|\(|\)|\&|\|)/g) { + if ($chunk eq '(') { + push @stack,($operand,$result); + } elsif ($chunk eq ')') { + my $before=pop @stack; + if (pop @stack eq '&') { + $result=$result>$before?$before:$result; + } else { + $result=$result>$before?$result:$before; + } + } elsif (($chunk eq '&') || ($chunk eq '|')) { + $operand=$chunk; + } else { + my $new=directcondval($chunk); + if ($operand eq '&') { + $result=$result>$new?$new:$result; + } else { + $result=$result>$new?$result:$new; + } + } + } } return $result; } @@ -4837,8 +4877,14 @@ sub EXT { if ( (defined($Apache::lonhomework::parsing_a_problem) || defined($Apache::lonhomework::parsing_a_task)) && - ($symbparm eq &symbread()) ) { - return $Apache::lonhomework::history{$qualifierrest}; + ($symbparm eq &symbread()) ) { + # if we are in the middle of processing the resource the + # get the value we are planning on committing + if (defined($Apache::lonhomework::results{$qualifierrest})) { + return $Apache::lonhomework::results{$qualifierrest}; + } else { + return $Apache::lonhomework::history{$qualifierrest}; + } } else { my %restored; if ($publicuser || $env{'request.state'} eq 'construct') { @@ -4930,7 +4976,7 @@ sub EXT { # ----------------------------------------------------- Cascading lookup scheme my $symbp=$symbparm; - my $mapp=(&decode_symb($symbp))[0]; + my $mapp=&deversion((&decode_symb($symbp))[0]); my $symbparm=$symbp.'.'.$spacequalifierrest; my $mapparm=$mapp.'___(all).'.$spacequalifierrest;