version 1.44, 2004/02/26 22:08:54
|
version 1.46, 2004/03/31 05:24:00
|
Line 27 package Apache::run;
|
Line 27 package Apache::run;
|
|
|
use HTML::Entities; |
use HTML::Entities; |
|
|
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE'; |
my %_LONCAPA_INTERNAL_oldexpressions=(); |
my %_LONCAPA_INTERNAL_oldexpressions=(); |
while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { |
while (!$_LONCAPA_INTERNAL_oldexpressions{$_}) { |
$_LONCAPA_INTERNAL_oldexpressions{$_}=1; |
$_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/ # $1 will be the variable reference or subroutine name |
|
((?:\$|\&) #look for a starting $ or & |
|
(?:[\#|\$]* #support $$ or $#$ etc. |
|
[A-Za-z][\w]*| # get variable name |
|
\{[A-Za-z][\w]*\})) # for ${a} |
|
# $2 is 0 or more array dereferences [] |
|
# or hash dereferences {} |
|
# the ^$ and ^& is because we do this iteratively |
|
# $a[$c] becomes $a[3] which then evaluates |
|
([\[\{][^\$\&\]\}]+[\]\}])*? |
|
# $3 is the list of arguments |
|
(\([^\$\&\)]+\))*? |
|
# only match the above if there is not { [ ( coming up |
|
# Why? (I.e. this fails &a(1)[2] |
|
(?=[^\[\{\(]|$)/ |
|
&__LC_INTERNAL_EVALUATE__($1,$2,$3)/sexg; |
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} |
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} |
} |
} |
ENDEVALUATE |
ENDEVALUATE |
|
|
sub evaluate { |
sub evaluate { |
Line 65 sub evaluate {
|
Line 80 sub evaluate {
|
$Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds'; |
$Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds'; |
} |
} |
&Apache::lonxml::error('substitution on <pre>'. |
&Apache::lonxml::error('substitution on <pre>'. |
&HTML::Entities::encode($expression). |
&HTML::Entities::encode($expression,'<>&"'). |
'</pre> with <pre>'. |
'</pre> with <pre>'. |
&HTML::Entities::encode($decls). |
&HTML::Entities::encode($decls,'<>&"'). |
'</pre> caused <pre>'. |
'</pre> caused <pre>'. |
&HTML::Entities::encode($error).' '. |
&HTML::Entities::encode($error,'<>&"').' '. |
&HTML::Entities::encode($innererror). |
&HTML::Entities::encode($innererror,'<>&"'). |
'</pre>'); |
'</pre>'); |
} |
} |
return $result |
return $result |
Line 98 sub run {
|
Line 113 sub run {
|
$error = 'Code ran too long. It ran for more than '. |
$error = 'Code ran too long. It ran for more than '. |
$Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds'; |
$Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds'; |
} |
} |
my $errormsg='<pre>'.&HTML::Entities::encode($error).' '. |
my $errormsg='<pre>'.&HTML::Entities::encode($error,'<>&"').' '. |
&HTML::Entities::encode($innererror). |
&HTML::Entities::encode($innererror,'<>&"'). |
'</pre> occured while running <pre>'; |
'</pre> occured while running <pre>'; |
$code=&HTML::Entities::encode($code); |
$code=&HTML::Entities::encode($code,'<>&"'); |
if ($innererror=~/line (\d+)/) { |
if ($innererror=~/line (\d+)/) { |
my $linenumber=$1; |
my $linenumber=$1; |
my @code=split("\n",$code); |
my @code=split("\n",$code); |
Line 138 sub dump {
|
Line 153 sub dump {
|
$symname.'{$_} } sort keys %'. |
$symname.'{$_} } sort keys %'. |
$symname.')').")" |
$symname.')').")" |
} |
} |
if ($line ne '') {$dump.=&HTML::Entities::encode($line)."<br />";} |
if ($line ne '') {$dump.=&HTML::Entities::encode($line,'<>&"')."<br />";} |
} |
} |
} |
} |
$dump.=''; |
$dump.=''; |