--- loncom/xml/lonxml.pm 2005/04/07 06:56:27 1.372
+++ loncom/xml/lonxml.pm 2005/11/10 21:38:27 1.388
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.372 2005/04/07 06:56:27 albertel Exp $
+# $Id: lonxml.pm,v 1.388 2005/11/10 21:38:27 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -180,8 +180,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);
@@ -382,33 +382,6 @@ sub xmlparse {
return $finaloutput;
}
-sub htmlclean {
- my ($raw,$full)=@_;
-# Take care of CRLF etc
-
- $raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs;
- $raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs;
- $raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs;
- $raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs;
-
-# Generate empty tags, remove wrong end tags
- $raw=~s/\<(br|hr|img|meta|allow|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis;
- $raw=~s/\<\/(br|hr|img|meta|allow|basefont)\>//gis;
- unless ($full) {
- $raw=~s/\<[\/]*(body|head|html)\>//gis;
- }
-# Make standard tags lowercase
- foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
- 'table','tr','td','th','p','br','hr','img','embed','font',
- 'a','strong','center','title','basefont','li','ol','ul',
- 'input','select','form','option','script','pre') {
- $raw=~s/\<$_\s*\>/\<$_\>/gis;
- $raw=~s/\<\/$_\s*\>/<\/$_\>/gis;
- $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis;
- }
- return $raw;
-}
-
sub latex_special_symbols {
my ($string,$where)=@_;
if ($where eq 'header') {
@@ -424,6 +397,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;
@@ -553,7 +527,13 @@ sub inner_xmlparse {
# $finaloutput.=&endredirection;
# }
-
+ if ($target eq 'grade') { &endredirection(); }
+ if ( $Apache::lonxml::redirection ) {
+ &error("Unclean exit of parser, text still being redirected. This is likely due to there being missing end tags.");
+ while ($Apache::lonxml::redirection) {
+ $finaloutput.=&endredirection();
+ }
+ }
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);
}
@@ -662,7 +642,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;
@@ -691,6 +671,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");
@@ -748,6 +731,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');
@@ -784,13 +797,18 @@ sub init_safespace {
# $safeeval->deny(":base_orig");
$safeeval->permit("require");
$safeinit .= ';$external::target="'.$target.'";';
- my $rndseed;
- my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
- $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
- $safeinit .= ';$external::randomseed="'.$rndseed.'";';
- &Apache::lonxml::debug("Setting rndseed to $rndseed");
&Apache::run::run($safeinit,$safeeval);
+ &initialize_rndseed($safeeval);
+}
+sub initialize_rndseed {
+ my ($safeeval)=@_;
+ my $rndseed;
+ my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+ $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
+ my $safeinit = '$external::randomseed="'.$rndseed.'";';
+ &Apache::lonxml::debug("Setting rndseed to $rndseed");
+ &Apache::run::run($safeinit,$safeeval);
}
sub default_homework_load {
@@ -839,7 +857,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--;
@@ -914,7 +932,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') {
@@ -980,7 +1002,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') {
@@ -1032,7 +1058,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') {
@@ -1085,9 +1115,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};
}
@@ -1169,7 +1207,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>
@@ -1233,10 +1270,7 @@ FULLPAGE
$xml_help=&Apache::loncommon::helpLatexCheatsheet();
}
my $cleanbut = '';
- if ($filetype eq 'html') {
- $cleanbut='<input type="submit" name="attemptclean" value="'.
- &mt('Save and then attempt to clean HTML').'" />';
- }
+
my $titledisplay=&display_title();
my %lt=&Apache::lonlocal::texthash('st' => 'Save this',
'vi' => 'View',
@@ -1324,7 +1358,7 @@ sub handler {
# Edit action? Save file.
#
unless ($env{'request.state'} eq 'published') {
- if (($env{'form.savethisfile'}) || ($env{'form.attemptclean'})) {
+ if ($env{'form.savethisfile'}) {
if (&storefile($file,$env{'form.filecont'})) {
&Apache::lonxml::info("<font COLOR=\"#0000FF\">".
&mt('Updated').": ".
@@ -1361,21 +1395,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.'));
- }
-
- if ($env{'form.attemptclean'}) {
- $filecontents=&htmlclean($filecontents,1);
+ &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{'rawmode'}) { $result = $filecontents; }
}
}
@@ -1423,7 +1456,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]);
}
@@ -1460,14 +1498,26 @@ sub error {
&Apache::lonmsg::author_res_msg($env{'request.filename'},join('<br />',@_));
#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,
+ 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]",join('<br />',@_));
+ &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));
@@ -1484,8 +1534,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");