--- loncom/xml/run.pm 2004/07/13 19:12:46 1.47
+++ loncom/xml/run.pm 2013/12/04 15:57:15 1.62
@@ -1,6 +1,6 @@
package Apache::run;
#
-# $Id: run.pm,v 1.47 2004/07/13 19:12:46 albertel Exp $
+# $Id: run.pm,v 1.62 2013/12/04 15:57:15 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,6 +26,7 @@ package Apache::run;
#
use HTML::Entities;
+use Apache::lonlocal;
$Apache::run::EVALUATE_STRING=<<'ENDEVALUATE';
my %_LONCAPA_INTERNAL_oldexpressions=();
@@ -48,23 +49,24 @@ while (!$_LONCAPA_INTERNAL_oldexpression
(?=[^\[\{\(]|$)/
my ($__LC__a,$__LC__b,$__LC__c)=($1,$2,$3);
my $__LC__prefix;
- my $result;
+ my $__LC__result;
while (1) {
+ if ($__LC__a =~ m-^&(theta|pi|rho)$-) { last; }
{
use strict;
no strict "vars";
if (eval(defined(eval($__LC__a.$__LC__b)))) {
- $result= $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c);
+ $__LC__result= $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c);
last;
}
}
$__LC__prefix.=substr($__LC__a,0,1,"");
if ($__LC__a!~m-^(\$|&|\#)-) { last; }
}
- if (!defined($result)) {
- $result=$__LC__prefix.$__LC__a.$__LC__b.$__LC__c;
+ if (!defined($__LC__result)) {
+ $__LC__result=$__LC__prefix.$__LC__a.$__LC__b.$__LC__c;
}
- $result;
+ $__LC__result;
/sexg;
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;}
}
@@ -77,39 +79,37 @@ sub evaluate {
my $result = '';
$@='';
$Apache::run::timeout=0;
- $main::SIG{'ALRM'} = sub {
+ local $main::SIG{'ALRM'} = sub {
$Apache::run::timeout=1;
die("timeout");
};
my $innererror;
- $safeeval->permit("require");
eval {
- alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
+ &Apache::lonxml::start_alarm();
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression.
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}');
$innererror=$@;
- alarm(0);
+ &Apache::lonxml::end_alarm();
};
- $safeeval->deny("require");
- my $error=$@;
+ my $error=$@;
if ($error eq '' && $innererror eq '' && !$Apache::run::timeout) {
$result = $safeeval->reval('return $_;');
chomp $result;
} else {
- if ($Apache::run::timeout) {
- $error = 'Code ran too long. It ran for more than '.
- $Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds';
- }
- &Apache::lonxml::error('substitution on <pre>'.
- &HTML::Entities::encode($expression,'<>&"').
- '</pre> with <pre>'.
- &HTML::Entities::encode($decls,'<>&"').
- '</pre> caused <pre>'.
- &HTML::Entities::encode($error,'<>&"').' '.
- &HTML::Entities::encode($innererror,'<>&"').
- '</pre>');
+ if ($Apache::run::timeout) {
+ $error =
+ &mt('Code ran too long. It ran for more than [_1] seconds.',
+ $Apache::lonnet::perlvar{'lonScriptTimeout'});
+ }
+ &Apache::lonxml::error(
+ &mt('Substitution on [_1] with [_2] caused:',
+ '<pre>'. &HTML::Entities::encode($expression,'<>&"').'</pre>',
+ '<pre>'.&HTML::Entities::encode($decls,'<>&"').'</pre>')
+ .'<br />'
+ .'<pre>'.&HTML::Entities::encode($error,'<>&"').' '
+ .&HTML::Entities::encode($innererror,'<>&"').'</pre>');
}
- return $result
+ return $result;
}
sub run {
@@ -117,35 +117,40 @@ sub run {
my @result;
$@='';
$Apache::run::timeout=0;
- $main::SIG{'ALRM'} = sub {
+ local $main::SIG{'ALRM'} = sub {
$Apache::run::timeout=1;
die("timeout");
};
my $innererror;
eval {
- alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
+ &Apache::lonxml::start_alarm();
@result=$safeeval->reval($code);
$innererror=$@;
- alarm(0);
+ &Apache::lonxml::end_alarm();
};
my $error=$@;
if (($Apache::run::timeout || $error ne '' || $innererror ne '') && !$hideerrors) {
- if ($Apache::run::timeout) {
- $error = 'Code ran too long. It ran for more than '.
- $Apache::lonnet::perlvar{'lonScriptTimeout'}.' seconds';
- }
- my $errormsg='<pre>'.&HTML::Entities::encode($error,'<>&"').' '.
- &HTML::Entities::encode($innererror,'<>&"').
- '</pre> occured while running <pre>';
- $code=&HTML::Entities::encode($code,'<>&"');
- if ($innererror=~/line (\d+)/) {
- my $linenumber=$1;
- my @code=split("\n",$code);
- $code[$linenumber-1]='<b><font color="red">'.
- $code[$linenumber-1].'</font></b>';
- $code=join("\n",@code);
- }
- &Apache::lonxml::error($errormsg.$code.'</pre>');
+ if ($Apache::run::timeout) {
+ $error = &mt('Code ran too long. It ran for more than [_1] seconds.',
+ $Apache::lonnet::perlvar{'lonScriptTimeout'});
+ }
+ $code=&HTML::Entities::encode($code,'<>&"');
+ if ($innererror=~/line (\d+)/) {
+ my $linenumber=$1;
+ my @code=split("\n",$code);
+ if ($linenumber < scalar(@code)) {
+ $code[$linenumber-1]=
+ '<span style="color:red;font-weight:bold;">'.
+ $code[$linenumber-1].'</span>';
+ }
+ $code=join("\n",@code);
+ }
+ &Apache::lonxml::error(
+ '<pre>'.&HTML::Entities::encode($error,'<>&"').' '.
+ &HTML::Entities::encode($innererror,'<>&"').
+ '</pre>'
+ .&mt('This occurred while running: [_1]',
+ '<pre>'.$code.'</pre>'));
}
if ( $#result < '1') {
return $result[0];
@@ -159,22 +164,29 @@ sub dump {
my ($target,$safeeval)=@_;
my $dump='';
foreach my $symname (sort keys %{$safeeval->varglob('main::')}) {
- if (($symname!~/^\_/) && ($symname!~/\:$/)) {
+ if (($symname!~ /^(INC|SIG)/) && ($symname!~/\027/) &&
+ ($symname!~/^\_/) && ($symname!~/\:$/)) {
my $line;
if ($safeeval->reval('defined($'.$symname.')')) {
- $line='$'.$symname.'='.$safeeval->reval('$'.$symname);
+ if ($symname =~ /^\w/) {
+ $line.='$'.$symname.'='.$safeeval->reval('$'.$symname)."\n";
+ }
}
- if ($safeeval->reval('defined(@'.$symname.')')) {
- $line='@'.$symname.'=('.
- $safeeval->reval('join(",",@'.$symname.')').")";
+ if ($safeeval->reval('@'.$symname)) {
+ $line.='@'.$symname.'=('.
+ $safeeval->reval('join(",",@'.$symname.')').")"."\n";
}
- if ($safeeval->reval('defined(%'.$symname.')')) {
- $line='%'.$symname.'=(';
+ if ($safeeval->reval('%'.$symname)) {
+ $line.='%'.$symname.'=(';
$line.=$safeeval->reval('join(",",map { $_."=>".$'.
$symname.'{$_} } sort keys %'.
- $symname.')').")"
- }
- if ($line ne '') {$dump.=&HTML::Entities::encode($line,'<>&"')."<br />";}
+ $symname.')').")"."\n";
+ }
+ if ($line ne '') {
+ $line=&HTML::Entities::encode($line,'<>&"');
+ $line=~s|\n|<br />|g;
+ $dump.=$line;
+ }
}
}
$dump.='';
@@ -183,3 +195,29 @@ sub dump {
1;
__END__;
+
+=pod
+
+=head1 NAME
+
+Apache::run.pm
+
+=head1 SYNOPSIS
+
+Used to prevent poorly written problems from
+causing lingering after effects
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+
+=head1 NOTABLE SUBROUTINES
+
+=over
+
+=item run(), dump(), evaluate()
+
+=back
+
+=cut
+