version 1.47, 2004/07/13 19:12:46
|
version 1.61, 2012/12/18 18:27:43
|
Line 48 while (!$_LONCAPA_INTERNAL_oldexpression
|
Line 48 while (!$_LONCAPA_INTERNAL_oldexpression
|
(?=[^\[\{\(]|$)/ |
(?=[^\[\{\(]|$)/ |
my ($__LC__a,$__LC__b,$__LC__c)=($1,$2,$3); |
my ($__LC__a,$__LC__b,$__LC__c)=($1,$2,$3); |
my $__LC__prefix; |
my $__LC__prefix; |
my $result; |
my $__LC__result; |
while (1) { |
while (1) { |
|
if ($__LC__a =~ m-^&(theta|pi|rho)$-) { last; } |
{ |
{ |
use strict; |
use strict; |
no strict "vars"; |
no strict "vars"; |
if (eval(defined(eval($__LC__a.$__LC__b)))) { |
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; |
last; |
} |
} |
} |
} |
$__LC__prefix.=substr($__LC__a,0,1,""); |
$__LC__prefix.=substr($__LC__a,0,1,""); |
if ($__LC__a!~m-^(\$|&|\#)-) { last; } |
if ($__LC__a!~m-^(\$|&|\#)-) { last; } |
} |
} |
if (!defined($result)) { |
if (!defined($__LC__result)) { |
$result=$__LC__prefix.$__LC__a.$__LC__b.$__LC__c; |
$__LC__result=$__LC__prefix.$__LC__a.$__LC__b.$__LC__c; |
} |
} |
$result; |
$__LC__result; |
/sexg; |
/sexg; |
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} |
if (scalar(values(%_LONCAPA_INTERNAL_oldexpressions))>10) {last;} |
} |
} |
Line 77 sub evaluate {
|
Line 78 sub evaluate {
|
my $result = ''; |
my $result = ''; |
$@=''; |
$@=''; |
$Apache::run::timeout=0; |
$Apache::run::timeout=0; |
$main::SIG{'ALRM'} = sub { |
local $main::SIG{'ALRM'} = sub { |
$Apache::run::timeout=1; |
$Apache::run::timeout=1; |
die("timeout"); |
die("timeout"); |
}; |
}; |
my $innererror; |
my $innererror; |
$safeeval->permit("require"); |
|
eval { |
eval { |
alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); |
&Apache::lonxml::start_alarm(); |
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
$safeeval->reval('{'.$decls.';$_=<<\'EXPRESSION\';'."\n".$expression. |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
"\n".'EXPRESSION'."\n".$EVALUATE_STRING.'}'); |
$innererror=$@; |
$innererror=$@; |
alarm(0); |
&Apache::lonxml::end_alarm(); |
}; |
}; |
$safeeval->deny("require"); |
my $error=$@; |
my $error=$@; |
|
if ($error eq '' && $innererror eq '' && !$Apache::run::timeout) { |
if ($error eq '' && $innererror eq '' && !$Apache::run::timeout) { |
$result = $safeeval->reval('return $_;'); |
$result = $safeeval->reval('return $_;'); |
chomp $result; |
chomp $result; |
Line 117 sub run {
|
Line 116 sub run {
|
my @result; |
my @result; |
$@=''; |
$@=''; |
$Apache::run::timeout=0; |
$Apache::run::timeout=0; |
$main::SIG{'ALRM'} = sub { |
local $main::SIG{'ALRM'} = sub { |
$Apache::run::timeout=1; |
$Apache::run::timeout=1; |
die("timeout"); |
die("timeout"); |
}; |
}; |
my $innererror; |
my $innererror; |
eval { |
eval { |
alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); |
&Apache::lonxml::start_alarm(); |
@result=$safeeval->reval($code); |
@result=$safeeval->reval($code); |
$innererror=$@; |
$innererror=$@; |
alarm(0); |
&Apache::lonxml::end_alarm(); |
}; |
}; |
my $error=$@; |
my $error=$@; |
if (($Apache::run::timeout || $error ne '' || $innererror ne '') && !$hideerrors) { |
if (($Apache::run::timeout || $error ne '' || $innererror ne '') && !$hideerrors) { |
Line 136 sub run {
|
Line 135 sub run {
|
} |
} |
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> occurred 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); |
$code[$linenumber-1]='<b><font color="red">'. |
if ($linenumber < scalar(@code)) { |
$code[$linenumber-1].'</font></b>'; |
$code[$linenumber-1]='<b><font color="red">'. |
|
$code[$linenumber-1].'</font></b>'; |
|
} |
$code=join("\n",@code); |
$code=join("\n",@code); |
} |
} |
&Apache::lonxml::error($errormsg.$code.'</pre>'); |
&Apache::lonxml::error($errormsg.$code.'</pre>'); |
Line 159 sub dump {
|
Line 160 sub dump {
|
my ($target,$safeeval)=@_; |
my ($target,$safeeval)=@_; |
my $dump=''; |
my $dump=''; |
foreach my $symname (sort keys %{$safeeval->varglob('main::')}) { |
foreach my $symname (sort keys %{$safeeval->varglob('main::')}) { |
if (($symname!~/^\_/) && ($symname!~/\:$/)) { |
if (($symname!~ /^(INC|SIG)/) && ($symname!~/\027/) && |
|
($symname!~/^\_/) && ($symname!~/\:$/)) { |
my $line; |
my $line; |
if ($safeeval->reval('defined($'.$symname.')')) { |
if ($safeeval->reval('defined($'.$symname.')')) { |
$line='$'.$symname.'='.$safeeval->reval('$'.$symname); |
if ($symname =~ /^\w/) { |
|
$line.='$'.$symname.'='.$safeeval->reval('$'.$symname)."\n"; |
|
} |
} |
} |
if ($safeeval->reval('defined(@'.$symname.')')) { |
if ($safeeval->reval('@'.$symname)) { |
$line='@'.$symname.'=('. |
$line.='@'.$symname.'=('. |
$safeeval->reval('join(",",@'.$symname.')').")"; |
$safeeval->reval('join(",",@'.$symname.')').")"."\n"; |
} |
} |
if ($safeeval->reval('defined(%'.$symname.')')) { |
if ($safeeval->reval('%'.$symname)) { |
$line='%'.$symname.'=('; |
$line.='%'.$symname.'=('; |
$line.=$safeeval->reval('join(",",map { $_."=>".$'. |
$line.=$safeeval->reval('join(",",map { $_."=>".$'. |
$symname.'{$_} } sort keys %'. |
$symname.'{$_} } sort keys %'. |
$symname.')').")" |
$symname.')').")"."\n"; |
} |
} |
if ($line ne '') {$dump.=&HTML::Entities::encode($line,'<>&"')."<br />";} |
if ($line ne '') { |
|
$line=&HTML::Entities::encode($line,'<>&"'); |
|
$line=~s|\n|<br />|g; |
|
$dump.=$line; |
|
} |
} |
} |
} |
} |
$dump.=''; |
$dump.=''; |
Line 183 sub dump {
|
Line 191 sub dump {
|
|
|
1; |
1; |
__END__; |
__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 |
|
|