version 1.23, 2002/02/15 21:33:12
|
version 1.26, 2002/04/10 15:22:02
|
Line 25 package Apache::run;
|
Line 25 package Apache::run;
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
sub evaluateold { |
use HTML::Entities; |
my ($expression,$safeeval,$decls) = @_; |
|
# print "inside2 evaluate $decls with $expression<br />\n"; |
|
# gerd's old method interpolates unset vars |
|
# $safeeval->reval('return qq('.$expression.');'); |
|
unless (defined($expression)) { 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:$@:"); |
|
} |
|
return $result |
|
} |
|
|
|
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
my %oldexpressions=(); |
my %_LONCAPA_INTERNAL_oldexpressions=(); |
while (!$oldexpressions{$_}) { |
my $i=0; |
$oldexpressions{$_}=1; |
while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { |
|
$_LONCAPA_INTERNAL_oldexpressions{$_}=1; |
$_ =~s/((?:\$|\&)(?:[\#|\$]*[A-Za-z][\w]*|\{[A-Za-z][\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; |
|
if ($i++ > 10 ) { last; } |
} |
} |
ENDEVALUATE |
ENDEVALUATE |
|
|
Line 64 sub evaluate {
|
Line 46 sub evaluate {
|
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); |
# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}'); |
|
my $error=$@; |
if ($@ eq '') { |
if ($@ eq '') { |
$result = $safeeval->reval('return $_;'); |
$result = $safeeval->reval('return $_;'); |
chomp $result; |
chomp $result; |
} else { |
} else { |
&Apache::lonxml::error("substitution on:$expression:with:$decls:caused $@"); |
&Apache::lonxml::error('substitution on <pre>'.$expression. |
|
'</pre> with <pre>'.$decls. |
|
'</pre> caused <pre>'.$error); |
} |
} |
return $result |
return $result |
} |
} |
Line 78 sub run {
|
Line 63 sub run {
|
# print "inside run\n"; |
# print "inside run\n"; |
$@=''; |
$@=''; |
my (@result)=$safeeval->reval($code); |
my (@result)=$safeeval->reval($code); |
if ($@ ne '' && !$hideerrors) { |
my $error=$@; |
&Apache::lonxml::error(":$@: occured while running :$code:"); |
if ($error ne '' && !$hideerrors) { |
|
&Apache::lonxml::error('<pre>'.&HTML::Entities::encode($error). |
|
'</pre> occured while running <pre>'. |
|
&HTML::Entities::encode($code).'</pre>'); |
} |
} |
if ( $#result < '1') { |
if ( $#result < '1') { |
return $result[0]; |
return $result[0]; |