--- loncom/xml/run.pm 2000/11/14 22:24:38 1.10 +++ loncom/xml/run.pm 2001/11/07 22:29:17 1.20 @@ -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 ''; } @@ -23,14 +23,26 @@ sub evaluateold { 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.';&evaluate(q|'.$expression.'|);}'); + $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 $@"); } @@ -38,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($@); + } + 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;