--- loncom/xml/run.pm 2000/09/19 18:05:21 1.6
+++ loncom/xml/run.pm 2001/05/04 21:17:24 1.16
@@ -1,20 +1,70 @@
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 ''; }
- $safeeval->reval('$_=\''.$expression.'\';');
- $safeeval->reval('{'.$decls.'$_=~s/(\$\{?[A-Za-z]\w*\}?)/(defined(eval($1))?eval($1):$1)/ge;}');
- $safeeval->reval('return $_;');
+ my $result = '';
+ $@='';
+ $safeeval->reval('$_=q|'.$expression.'|;');
+ if ($@ eq '') {
+ $safeeval->reval('{'.$decls.'$_=~s/(\$[A-Za-z]\w*)/(defined(eval($1))?eval($1):$1)/ge;}');
+ if ($@ eq '') {
+ $result = $safeeval->reval('return $_;');
+ } else {
+ &Apache::lonxml::error("substitution on:$expression:with:$decls:caused");
+ }
+ } else {
+ &Apache::lonxml::error("defining:$expression:caused");
+ }
+ if ($@ ne '') {&Apache::lonxml::error($@);}
+ 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 = '';
+ $@='';
+ 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 $@");
+ }
+ return $result
}
sub run {
my ($code,$safeeval) = @_;
# print "inside run\n";
- $safeeval->reval($code);
+ $@='';
+ my (@result)=$safeeval->reval($code);
+ if ($@ ne '') {
+ &Apache::lonxml::error(":$code:caused");
+ &Apache::lonxml::error($@);
+ }
+ if ( $#result < '1') {
+ return $result[0];
+ } else {
+ &Apache::lonxml::debug("Got lots results:$#result:");
+ return (@result);
+ }
}
1;