--- loncom/xml/run.pm 2000/11/15 15:29:33 1.11 +++ loncom/xml/run.pm 2001/10/05 22:27:41 1.19 @@ -2,7 +2,7 @@ package Apache::run; 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 ''; } @@ -27,21 +27,22 @@ $Apache::run::EVALUATE_STRING=<<'ENDEVAL my %oldexpressions=(); while (!$oldexpressions{$_}) { $oldexpressions{$_}=1; - $_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\w]*\}))([\[|\{][\w\'\"]+[\]\}])*?(\([\w\'\"]+\))*?(?=[^\[\{\(]|$)/eval(defined(eval($1.$2))?eval('$1.$2.$3'):'$1.$2.$3')/seg; + $_ =~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 = ''; $@=''; - print $decls $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 $@"); } @@ -49,15 +50,44 @@ sub evaluate { } 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($@); } - return $result; + 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"; + } + } + } + $dump.=''; + return $dump; } 1;