--- loncom/xml/run.pm 2001/11/07 22:29:17 1.20
+++ loncom/xml/run.pm 2002/04/10 15:22:02 1.26
@@ -1,50 +1,59 @@
package Apache::run;
+#
+# $Id: run.pm,v 1.26 2002/04/10 15:22:02 albertel Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
-sub evaluateold {
- my ($expression,$safeeval,$decls) = @_;
-# print "inside2 evaluate $decls with $expression
\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");
- }
- if ($@ ne '') {&Apache::lonxml::error($@);}
- return $result
-}
+use HTML::Entities;
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE';
- my %oldexpressions=();
- while (!$oldexpressions{$_}) {
- $oldexpressions{$_}=1;
+ my %_LONCAPA_INTERNAL_oldexpressions=();
+ my $i=0;
+ 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;
+ if ($i++ > 10 ) { last; }
}
ENDEVALUATE
sub evaluate {
my ($expression,$safeeval,$decls) = @_;
- unless (defined $expression) { return ''; }
+ unless (defined($expression)) { return ''; }
if (!$Apache::lonxml::evaluate) { return $expression; }
my $result = '';
$@='';
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression.
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}');
# $safeeval->reval('{'.$decls.';<< &evaluate(q|'.$expression.'|);}');
+ my $error=$@;
if ($@ eq '') {
$result = $safeeval->reval('return $_;');
chomp $result;
} else {
- &Apache::lonxml::error("substitution on:$expression:with:$decls:caused $@");
+ &Apache::lonxml::error('substitution on
'.$expression. + 'with
'.$decls. + 'caused
'.$error); } return $result } @@ -54,9 +63,11 @@ sub run { # print "inside run\n"; $@=''; my (@result)=$safeeval->reval($code); - if ($@ ne '' && !$hideerrors) { - &Apache::lonxml::error(":$code:caused"); - &Apache::lonxml::error($@); + my $error=$@; + if ($error ne '' && !$hideerrors) { + &Apache::lonxml::error(''.&HTML::Entities::encode($error). + 'occured while running'. + &HTML::Entities::encode($code).''); } if ( $#result < '1') { return $result[0]; @@ -74,11 +85,11 @@ sub dump { if ($safeeval->reval('defined($'.$symname.')')) { $dump.='$'.$symname.'='.$safeeval->reval('$'.$symname)."\n"; } - if ($safeeval->reval('defined @'.$symname)) { + if ($safeeval->reval('defined(@'.$symname.')')) { $dump.='@'.$symname.'=('. $safeeval->reval('join(",",@'.$symname.')').")\n"; } - if ($safeeval->reval('defined %'.$symname)) { + if ($safeeval->reval('defined(%'.$symname.')')) { $dump.='%'.$symname.'=('; $dump.=$safeeval->reval('join(",",map { $_."=>".$'. $symname.'{$_} } sort keys %'.