--- loncom/xml/run.pm 2000/10/30 20:05:19 1.9 +++ loncom/xml/run.pm 2001/11/07 22:29:17 1.20 @@ -1,8 +1,8 @@ package Apache::run; -sub evaluate { +sub evaluateold { my ($expression,$safeeval,$decls) = @_; -# print "inside2 evaluate $decls with $expression
\n"; +# print "inside2 evaluate $decls with $expression
\n"; # gerd's old method interpolates unset vars # $safeeval->reval('return qq('.$expression.');'); unless (defined $expression) { return ''; } @@ -14,7 +14,7 @@ sub evaluate { if ($@ eq '') { $result = $safeeval->reval('return $_;'); } else { - &Apache::lonxml::error("substituion on:$expression:with:$decls:caused"); + &Apache::lonxml::error("substitution on:$expression:with:$decls:caused"); } } else { &Apache::lonxml::error("defining:$expression:caused"); @@ -23,16 +23,71 @@ sub evaluate { return $result } +$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; + my %oldexpressions=(); + while (!$oldexpressions{$_}) { + $oldexpressions{$_}=1; + $_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[\{][^\$\&\]\}]+[\]\}])*?(\([^\$\&\)]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg; + } +ENDEVALUATE + +sub evaluate { + my ($expression,$safeeval,$decls) = @_; + unless (defined $expression) { return ''; } + if (!$Apache::lonxml::evaluate) { return $expression; } + my $result = ''; + $@=''; + $safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. + "\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); +# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); + if ($@ eq '') { + $result = $safeeval->reval('return $_;'); + chomp $result; + } else { + &Apache::lonxml::error("substitution on:$expression:with:$decls:caused $@"); + } + return $result +} + sub run { - my ($code,$safeeval) = @_; + my ($code,$safeeval,$hideerrors) = @_; # print "inside run\n"; $@=''; - my $result=$safeeval->reval($code); - if ($@ ne '') { - &Apache::lonxml::error(":$code:caused"); - &Apache::lonxml::error($@); + my (@result)=$safeeval->reval($code); + if ($@ ne '' && !$hideerrors) { + &Apache::lonxml::error(":$code:caused"); + &Apache::lonxml::error($@); + } + if ( $#result < '1') { + return $result[0]; + } else { + &Apache::lonxml::debug("Got lots results:$#result:"); + return (@result); + } +} + +sub dump { + my ($target,$safeeval)=@_; + my $dump=''; + foreach my $symname (sort keys %{$safeeval->varglob('main::')}) { + if (($symname!~/^\_/) && ($symname!~/\:$/)) { + if ($safeeval->reval('defined($'.$symname.')')) { + $dump.='$'.$symname.'='.$safeeval->reval('$'.$symname)."\n"; + } + if ($safeeval->reval('defined @'.$symname)) { + $dump.='@'.$symname.'=('. + $safeeval->reval('join(",",@'.$symname.')').")\n"; + } + if ($safeeval->reval('defined %'.$symname)) { + $dump.='%'.$symname.'=('; + $dump.=$safeeval->reval('join(",",map { $_."=>".$'. + $symname.'{$_} } sort keys %'. + $symname.')').")\n"; + } + } } - return $result; + $dump.=''; + return $dump; } 1;