--- 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;