--- loncom/xml/lonxml.pm 2005/05/28 01:32:33 1.374
+++ loncom/xml/lonxml.pm 2006/04/18 20:43:47 1.407
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.374 2005/05/28 01:32:33 www Exp $
+# $Id: lonxml.pm,v 1.407 2006/04/18 20:43:47 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,6 +52,7 @@ use Math::Random();
use Opcode();
use POSIX qw(strftime);
use Time::HiRes qw( gettimeofday tv_interval );
+use Symbol();
sub register {
my ($space,@taglist) = @_;
@@ -148,6 +149,19 @@ $Apache::lonxml::post_evaluate=1;
#a header message to emit in the case of any generated warning or errors
$Apache::lonxml::warnings_error_header='';
+# Control whether or not LaTeX symbols should be substituted for their
+# \ style equivalents...this may be turned off e.g. in an verbatim
+# environment.
+
+$Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
+
+sub enable_LaTeX_substitutions {
+ $Apache::lonxml::substitute_LaTeX_symbols = 1;
+}
+sub disable_LaTeX_substitutions {
+ $Apache::lonxml::substitute_LaTeX_symbols = 0;
+}
+
sub xmlbegin {
my ($style)=@_;
my $output='';
@@ -180,8 +194,8 @@ sub xmlend {
$status=$Apache::inputtags::status[-1];
}
my $discussion;
- &Apache::loncommon::get_unprocessed_cgi
- ($env{'query_string'},['LONCAPA_INTERNAL_no_discussion']);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['LONCAPA_INTERNAL_no_discussion']);
if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) ||
$env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {
$discussion=&Apache::lonfeedback::list_discussion($mode,$status);
@@ -190,9 +204,9 @@ sub xmlend {
$discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
&Apache::lonxml::newparser($parser,\$discussion,'');
return '';
- } else {
- return $discussion.&Apache::loncommon::endbodytag();
}
+
+ return $discussion;
}
sub tokeninputfield {
@@ -272,13 +286,7 @@ sub printtokenheader {
$tcrsid=$courseid;
}
- my %reply=&Apache::lonnet::get('environment',
- ['firstname','middlename','lastname','generation'],
- $tudom,$tuname);
- my $plainname=$reply{'firstname'}.' '.
- $reply{'middlename'}.' '.
- $reply{'lastname'}.' '.
- $reply{'generation'};
+ my $plainname=&Apache::loncommon::plainname($tuname,$tudom);
if ($target eq 'web') {
my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
@@ -369,13 +377,16 @@ sub xmlparse {
&initdepth();
&init_alarm();
my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
- $safeeval,\%style_for_target);
+ $safeeval,\%style_for_target,1);
if ($env{'request.uri'}) {
&writeallows($env{'request.uri'});
}
&do_registered_ssi();
if ($Apache::lonxml::counter_changed) { &store_counter() }
+
+ &clean_safespace($safeeval);
+
if ($env{'form.return_only_error_and_warning_counts'}) {
return "$errorcount:$warningcount";
}
@@ -384,6 +395,13 @@ sub xmlparse {
sub latex_special_symbols {
my ($string,$where)=@_;
+ #
+ # If e.g. in verbatim mode, then don't substitute.
+ # but return original string.
+ #
+ if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
+ return $string;
+ }
if ($where eq 'header') {
$string =~ s/(\\|_|\^)/ /g;
$string =~ s/(\$|%|\{|\})/\\$1/g;
@@ -397,6 +415,7 @@ sub latex_special_symbols {
$string=~s/\\\%|\%/\\\%/g;
$string=~s/\\{|{/\\{/g;
$string=~s/\\}|}/\\}/g;
+ $string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
$string=~s/\\\$|\$/\\\$/g;
$string=~s/\\\_|\_/\\\_/g;
$string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;
@@ -412,11 +431,12 @@ sub latex_special_symbols {
}
sub inner_xmlparse {
- my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
+ my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
my $finaloutput = '';
my $result;
my $token;
my $dontpop=0;
+ my $startredirection = $Apache::lonxml::redirection;
while ( $#$pars > -1 ) {
while ($token = $$pars['-1']->get_token) {
if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
@@ -526,7 +546,12 @@ sub inner_xmlparse {
# $finaloutput.=&endredirection;
# }
-
+ if ( $start && $target eq 'grade') { &endredirection(); }
+ if ( $Apache::lonxml::redirection > $startredirection) {
+ while ($Apache::lonxml::redirection > $startredirection) {
+ $finaloutput .= &endredirection();
+ }
+ }
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);
}
@@ -624,6 +649,7 @@ sub setup_globals {
@Apache::lonxml::ssi_info=();
$Apache::lonxml::post_evaluate=1;
$Apache::lonxml::warnings_error_header='';
+ $Apache::lonxml::substitute_LaTeX_symbols = 1;
if ($target eq 'meta') {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;
@@ -635,7 +661,7 @@ sub setup_globals {
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;
} elsif ($target eq 'grade') {
- &startredirection;
+ &startredirection(); #ended in inner_xmlparse on exit
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;
@@ -664,6 +690,9 @@ sub setup_globals {
sub init_safespace {
my ($target,$safeeval,$safehole,$safeinit) = @_;
+ $safeeval->deny_only(':dangerous');
+ $safeeval->reval('use Math::Complex;');
+ $safeeval->permit_only(":default");
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
$safeeval->permit("sort");
@@ -721,6 +750,36 @@ sub init_safespace {
$safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
$safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');
+ $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat');
+ $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval,
+ '&Math::Cephes::Matrix::new');
+ $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval,
+ '&Math::Cephes::Matrix::coef');
+ $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval,
+ '&Math::Cephes::Matrix::clr');
+ $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval,
+ '&Math::Cephes::Matrix::add');
+ $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval,
+ '&Math::Cephes::Matrix::sub');
+ $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval,
+ '&Math::Cephes::Matrix::mul');
+ $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval,
+ '&Math::Cephes::Matrix::div');
+ $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval,
+ '&Math::Cephes::Matrix::inv');
+ $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval,
+ '&Math::Cephes::Matrix::transp');
+ $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval,
+ '&Math::Cephes::Matrix::simq');
+ $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval,
+ '&Math::Cephes::Matrix::mat_to_vec');
+ $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval,
+ '&Math::Cephes::Matrix::vec_to_mat');
+ $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
+ '&Math::Cephes::Matrix::check');
+ $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
+ '&Math::Cephes::Matrix::check');
+
# $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
# $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
# $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
@@ -761,6 +820,34 @@ sub init_safespace {
&initialize_rndseed($safeeval);
}
+sub clean_safespace {
+ my ($safeeval) = @_;
+ delete_package_recurse($safeeval->{Root});
+}
+
+sub delete_package_recurse {
+ my ($package) = @_;
+ my @subp;
+ {
+ no strict 'refs';
+ while (my ($key,$val) = each(%{*{"$package\::"}})) {
+ if (!defined($val)) { next; }
+ local (*ENTRY) = $val;
+ if (defined *ENTRY{HASH} && $key =~ /::$/ &&
+ $key ne "main::" && $key ne "<none>::")
+ {
+ my ($p) = $package ne "main" ? "$package\::" : "";
+ ($p .= $key) =~ s/::$//;
+ push(@subp,$p);
+ }
+ }
+ }
+ foreach my $p (@subp) {
+ delete_package_recurse($p);
+ }
+ Symbol::delete_package($package);
+}
+
sub initialize_rndseed {
my ($safeeval)=@_;
my $rndseed;
@@ -817,7 +904,7 @@ sub startredirection {
sub endredirection {
if (!$Apache::lonxml::redirection) {
- &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
+ &Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller);
return '';
}
$Apache::lonxml::redirection--;
@@ -884,6 +971,16 @@ sub decreasedepth {
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}
+sub get_id {
+ my ($parstack,$safeeval)=@_;
+ my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
+ if ($env{'request.state'} eq 'construct' && $id =~ /(\.|_)/) {
+ &error(&mt("IDs are not allowed to contain "<tt>_</tt>" or "<tt>.</tt>""));
+ }
+ if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
+ return $id;
+}
+
sub get_all_text_unbalanced {
#there is a copy of this in lonpublisher.pm
my($tag,$pars)= @_;
@@ -892,7 +989,11 @@ sub get_all_text_unbalanced {
$tag='<'.$tag.'>';
while ($token = $$pars[-1]->get_token) {
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
- $result.=$token->[1];
+ if ($token->[0] eq 'T' && $token->[2]) {
+ $result.='<![CDATA['.$token->[1].']]>';
+ } else {
+ $result.=$token->[1];
+ }
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
@@ -923,7 +1024,10 @@ sub increment_counter {
}
sub init_counter {
- if (defined($env{'form.counter'})) {
+ if ($env{'request.state'} eq 'construct') {
+ $Apache::lonxml::counter=1;
+ $Apache::lonxml::counter_changed=1;
+ } elsif (defined($env{'form.counter'})) {
$Apache::lonxml::counter=$env{'form.counter'};
$Apache::lonxml::counter_changed=0;
} else {
@@ -934,9 +1038,36 @@ sub init_counter {
sub store_counter {
&Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
+ $Apache::lonxml::counter_changed=0;
return '';
}
+{
+ my $state;
+ sub clear_problem_counter {
+ undef($state);
+ &Apache::lonnet::delenv('form.counter');
+ &Apache::lonxml::init_counter();
+ &Apache::lonxml::store_counter();
+ }
+
+ sub remember_problem_counter {
+ &Apache::lonnet::transfer_profile_to_env();
+ $state = $env{'form.counter'};
+ }
+
+ sub restore_problem_counter {
+ if (defined($state)) {
+ &Apache::lonnet::appenv(('form.counter' => $state));
+ }
+ }
+ sub get_problem_counter {
+ if ($Apache::lonxml::counter_changed) { &store_counter() }
+ &Apache::lonnet::transfer_profile_to_env();
+ return $env{'form.counter'};
+ }
+}
+
sub get_all_text {
my($tag,$pars,$style)= @_;
my $gotfullstack=1;
@@ -958,7 +1089,11 @@ sub get_all_text {
while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
- $result.=$token->[1];
+ if ($token->[2]) {
+ $result.='<![CDATA['.$token->[1].']]>';
+ } else {
+ $result.=$token->[1];
+ }
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
@@ -1010,7 +1145,11 @@ sub get_all_text {
#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
if (($token->[0] eq 'T')||($token->[0] eq 'C')||
($token->[0] eq 'D')) {
- $result.=$token->[1];
+ if ($token->[2]) {
+ $result.='<![CDATA['.$token->[1].']]>';
+ } else {
+ $result.=$token->[1];
+ }
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
@@ -1063,9 +1202,17 @@ sub parstring {
return $temp;
}
+sub extlink {
+ my ($res,$exact)=@_;
+ if (!$exact) {
+ $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);
+ }
+ push(@Apache::lonxml::extlinks,$res)
+}
+
sub writeallows {
unless ($#extlinks>=0) { return; }
- my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
+ my $thisurl = &Apache::lonnet::clutter(shift);
if ($env{'httpref.'.$thisurl}) {
$thisurl=$env{'httpref.'.$thisurl};
}
@@ -1147,7 +1294,6 @@ sub createnewhtml {
my $title=&mt('Title of document goes here');
my $body=&mt('Body of document goes here');
my $filecontents=(<<SIMPLECONTENT);
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml/11/DTD/xhtml11.dtd">
<html>
<head>
<title>$title</title>
@@ -1312,17 +1458,13 @@ sub handler {
my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents eq -1) {
- my $bodytag=&Apache::loncommon::bodytag('File Error');
+ my $start_page=&Apache::loncommon::start_page('File Error');
+ my $end_page=&Apache::loncommon::end_page('File Error');
my $fnf=&mt('File not found');
$result=(<<ENDNOTFOUND);
-<html>
-<head>
-<title>$fnf</title>
-</head>
-$bodytag
+$start_page
<b>$fnf: $file</b>
-</body>
-</html>
+$end_page
ENDNOTFOUND
$filecontents='';
if ($env{'request.state'} ne 'published') {
@@ -1336,17 +1478,20 @@ ENDNOTFOUND
} else {
unless ($env{'request.state'} eq 'published') {
if ($filecontents=~/BEGIN LON-CAPA Internal/) {
- &Apache::lonxml::error(&mt('This file appears to be a rendering of a Lon-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.'));
+ &Apache::lonxml::error(&mt('This file appears to be a rendering of a LON-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.'));
}
#
# we are in construction space, see if edit mode forced
- &Apache::loncommon::get_unprocessed_cgi
- ($ENV{'QUERY_STRING'},['editmode']);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['editmode']);
}
if (!$env{'form.editmode'} || $env{'form.viewmode'}) {
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
'',%mystyle);
undef($Apache::lonhomework::parsing_a_task);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['rawmode']);
+ if ($env{'form.rawmode'}) { $result = $filecontents; }
}
}
@@ -1357,18 +1502,20 @@ ENDNOTFOUND
if ($env{'form.editmode'} && (!($env{'form.viewmode'}))) {
my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;
- my $bodytag='<body bgcolor="#FFFFFF">';
- if ($env{'environment.remote'} eq 'off') {
- $bodytag=&Apache::loncommon::bodytag();
+ my %options = ();
+ if ($env{'environment.remote'} ne 'off') {
+ $options{'bgcolor'} = '#FFFFFF';
}
- $result='<html>'.$bodytag.
+ my $start_page = &Apache::loncommon::start_page(undef,undef,
+ \%options);
+ $result=$start_page.
&Apache::lonxml::message_location().'<h3>'.
$displayfile.
- '</h3></body></html>';
+ '</h3>'.&Apache::loncommon::end_page();
$result=&inserteditinfo($result,$filecontents,$filetype);
}
}
- if ($filetype eq 'html') { writeallows($request->uri); }
+ if ($filetype eq 'html') { &writeallows($request->uri); }
&Apache::lonxml::add_messages(\$result);
@@ -1394,7 +1541,12 @@ sub debug {
if ($Apache::lonxml::debug eq "1") {
$|=1;
my $request=$Apache::lonxml::request;
- if (!$request) { $request=Apache->request; }
+ if (!$request) {
+ eval { $request=Apache->request; };
+ }
+ if (!$request) {
+ eval { $request=Apache2::RequestUtil->request; };
+ }
$request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
#&Apache::lonnet::logthis($_[0]);
}
@@ -1426,19 +1578,32 @@ sub error {
if ( !$symb ) {
#public or browsers
$errormsg=&mt("An error occured while processing this resource. The author has been notified.");
- }
+ }
+ my $msg = join('<br />',@_);
#notify author
- &Apache::lonmsg::author_res_msg($env{'request.filename'},join('<br />',@_));
+ &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
#notify course
if ( $symb && $env{'request.course.id'} ) {
+ my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
my @userlist;
foreach (keys %users) {
my ($user,$domain) = split(/:/, $_);
push(@userlist,"$user\@$domain");
- &Apache::lonmsg::user_normal_msg($user,$domain,
- "Error [$declutter]",join('<br />',@_));
+ my $key=$declutter.'_'.$user.'_'.$domain;
+ my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
+ [$key],
+ $cdom,$cnum);
+ my $now=time;
+ if ($now-$lastnotified{$key}>86400) {
+ &Apache::lonmsg::user_normal_msg($user,$domain,
+ "Error [$declutter]",$msg);
+ &Apache::lonnet::put('nohist_xmlerrornotifications',
+ {$key => $now},
+ $cdom,$cnum);
+ }
}
if ($env{'request.role.adv'}) {
$errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
@@ -1455,8 +1620,6 @@ sub warning {
if ($env{'form.grade_target'} ne 'tex') {
if ( &show_error_warn_msg() ) {
- my $request=$Apache::lonxml::request;
- if (!$request) { $request=Apache->request; }
push(@Apache::lonxml::warning_messages,
$Apache::lonxml::warnings_error_header.
"<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");