--- loncom/xml/lonxml.pm 2003/11/21 18:54:10 1.294 +++ loncom/xml/lonxml.pm 2004/03/31 05:24:00 1.315 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.294 2003/11/21 18:54:10 albertel Exp $ +# $Id: lonxml.pm,v 1.315 2004/03/31 05:24:00 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ package Apache::lonxml; use vars -qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode $errorcount $warningcount); +qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount); use strict; use HTML::LCParser(); use HTML::TreeBuilder(); @@ -141,9 +141,6 @@ $evaluate = 1; # stores the list of active tag namespaces @namespace=(); -# if 0 all high ASCII characters will be encoded into HTML Entities -$prevent_entity_encode=0; - # has the dynamic menu been updated to know about this resource $Apache::lonxml::registered=0; @@ -167,6 +164,9 @@ $Apache::lonxml::style_end_values=''; #should we do the postag variable interpolation $Apache::lonxml::post_evaluate=1; +#a header message to emit in the case of any generated warning or errors +$Apache::lonxml::warnings_error_header=''; + sub xmlbegin { my $output=''; if ($ENV{'browser.mathml'}) { @@ -189,7 +189,7 @@ sub xmlend { $mode='problem'; $status=$Apache::inputtags::status[-1]; } - return &Apache::lonfeedback::list_discussion().''; + return &Apache::lonfeedback::list_discussion($mode,$status).''; } sub tokeninputfield { @@ -398,22 +398,25 @@ sub latex_special_symbols { my ($string,$where)=@_; if ($where eq 'header') { $string =~ s/(\\|_|\^)/ /g; - $string =~ s/(\$|%|\#|&|\{|\})/\\$1/g; + $string =~ s/(\$|%|\{|\})/\\$1/g; $string =~ s/_/ /g; + $string=&Apache::lonprintout::character_chart($string); + # any & or # leftover should be safe to just escape + $string=~s/([^\\])\&/$1\\\&/g; + $string=~s/([^\\])\#/$1\\\#/g; } else { - $string=~s/\\ /\\char92 /g; - $string=~s/\^/\\\^ /g; - $string=~s/\~/\\char126 /g; - #fixup & if it doesn't look like - # { or α - $string=~s/(&(?!((\#[0-9]+)|([a-z]+));))/\\$1/gi; - $string=~s/([^&])\#/$1\\#/g; - $string=~s/(\$|_|{|})/\\$1/g; - $string=~s/\\char92 /\\texttt{\\char92}/g; - $string=~s/(>|<)/\$$1\$/g; #more or less - if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit - if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space - if ($string eq '%.') {$string = '\%.';} #percent at the end of statement + $string=~s/\\/\\ensuremath{\\backslash}/g; + $string=~s/([^\\]|^)\%/$1\\\%/g; + $string=~s/([^\\]|^)(\$|_)/$1\\$2/g; + $string=~s/\$\$/\$\\\$/g; + $string=~s/\#\#/\#\\\#/g; + $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g; + $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less + $string=&Apache::lonprintout::character_chart($string); + # any & or # leftover should be safe to just escape + $string=~s/([^\\]|^)\&/$1\\\&/g; + $string=~s/([^\\]|^)\#/$1\\\#/g; +#single { or } How to escape? } return $string; } @@ -511,10 +514,6 @@ sub inner_xmlparse { } } - # Encode any high ASCII characters -# if (!$Apache::lonxml::prevent_entity_encode) { -# $result=&HTML::Entities::encode($result,"\200-\377"); -# } if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= $result; } else { @@ -625,6 +624,7 @@ sub setup_globals { @Apache::lonxml::extlinks=(); @Apache::lonxml::ssi_info=(); $Apache::lonxml::post_evaluate=1; + $Apache::lonxml::warnings_error_header=''; if ($target eq 'meta') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; @@ -745,6 +745,8 @@ sub init_safespace { $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); + $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); + $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); #need to inspect this class of ops # $safeeval->deny(":base_orig"); @@ -755,6 +757,28 @@ sub init_safespace { $safeinit .= ';$external::randomseed='.$rndseed.';'; &Apache::lonxml::debug("Setting rndseed to $rndseed"); &Apache::run::run($safeinit,$safeeval); + + my $subroutine=<<'EVALUATESUB'; +sub __LC_INTERNAL_EVALUATE__ { + my ($__LC__a,$__LC__b,$__LC__c)=@_; + my $__LC__prefix; + while(1){ + { + use strict; + no strict "vars"; + if (eval(defined(eval($__LC__a.$__LC__b)))) { + return $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c); + } + } + $__LC__prefix.=substr($__LC__a,0,1,""); + if ($__LC__a!~/^(\$|&|\#)/) { last; } + } + return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c; +} +EVALUATESUB + $safeeval->permit("require"); + $safeeval->reval($subroutine); + $safeeval->deny("require"); } sub default_homework_load { @@ -936,7 +960,7 @@ sub get_all_text { #never found the end tag ran out of text, throw error send back blank &error('Never found end tag for <'.$tag. '> current string 
'.
-		   &HTML::Entities::encode($result).
+		   &HTML::Entities::encode($result,'<>&"').
 		   '
'); if ($gotfullstack) { my $newstring=''.$result; @@ -994,7 +1018,6 @@ sub parstring { my $val=$token->[2]->{$_}; $val =~ s/([\%\@\\\"\'])/\\$1/g; #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } - if ($val !~ m/^\s*\$[a-z_]/i) { $val =~ s/\$/\\\$/g; } $temp .= "my \$$_=\"$val\";"; } } @@ -1114,7 +1137,7 @@ SIMPLECONTENT sub inserteditinfo { my ($result,$filecontents,$filetype)=@_; - $filecontents = &HTML::Entities::encode($filecontents); + $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); # my $editheader='Edit below
'; my $xml_help = ''; if ($filetype eq 'html') { @@ -1131,8 +1154,8 @@ sub inserteditinfo { 'ed' => 'Edit'); my $buttons=(< - + + BUTTONS my $editfooter=(< @@ -1210,8 +1233,10 @@ sub handler { unless ($ENV{'request.state'} eq 'published') { if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { if (&storefile($file,$ENV{'form.filecont'})) { - $request->print("".&mt('Updated').": ". -&Apache::lonlocal::locallocaltime(time)." "); + &Apache::lonxml::info("". + &mt('Updated').": ". + &Apache::lonlocal::locallocaltime(time). + " "); } } } @@ -1263,7 +1288,9 @@ ENDNOTFOUND if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { my $displayfile=$request->uri; $displayfile=~s/^\/[^\/]*//; - $result='

'.$displayfile. + $result=''. + &Apache::lonxml::message_location().'

'. + $displayfile. '

'; $result=&inserteditinfo($result,$filecontents,$filetype); } @@ -1271,7 +1298,7 @@ ENDNOTFOUND if ($filetype eq 'html') { writeallows($request->uri); } - + &Apache::lonxml::add_messages(\$result); $request->print($result); return OK; @@ -1291,19 +1318,27 @@ sub display_title { } sub debug { - if ($Apache::lonxml::debug eq 1) { - $|=1; - print('DEBUG:'.&HTML::Entities::encode($_[0])."\n"); - } + if ($Apache::lonxml::debug eq "1") { + $|=1; + my $request=$Apache::lonxml::request; + if (!$request) { $request=Apache->request; } + $request->print('
DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."
\n"); + } } sub error { $errorcount++; + my $request=$Apache::lonxml::request; + if (!$request) { $request=Apache->request; } if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { # If printing in construction space, put the error inside 

-    print "ERROR:".join("\n",@_)."\n";
+      push(@Apache::lonxml::error_messages,
+	   $Apache::lonxml::warnings_error_header.
+	   "ERROR:".join("
\n",@_)."
\n");
+      $Apache::lonxml::warnings_error_header='';
   } else {
-    print "An Error occured while processing this resource. The instructor has been notified. 
";
+      push(@Apache::lonxml::error_messages,
+	   "An Error occured while processing this resource. The instructor has been notified. 
");
     #notify author
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_));
     #notify course
@@ -1316,21 +1351,46 @@ sub error {
         "Error [$declutter]",join('
',@_));
       }
     }
-
-    #FIXME probably shouldn't have me get everything forever.
-    &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('
',@_));
-    #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
   }
 }
 
 sub warning {
-  $warningcount++;
+    $warningcount++;
   
-  if ($ENV{'form.grade_target'} ne 'tex') {
-      if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
-        print "WARNING:".join('
',@_)."
\n";
-      }
-  }
+    if ($ENV{'form.grade_target'} ne 'tex') {
+	if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
+	    my $request=$Apache::lonxml::request;
+	    if (!$request) { $request=Apache->request; }
+	    push(@Apache::lonxml::warning_messages,
+		 $Apache::lonxml::warnings_error_header.
+		 "WARNING:".join('
',@_)."
\n");
+	    $Apache::lonxml::warnings_error_header='';
+	}
+    }
+}
+
+sub info {
+    if ($ENV{'form.grade_target'} ne 'tex' 
+	&& $ENV{'request.state'} eq 'construct') {
+	push(@Apache::lonxml::info_messages,join('
',@_)."
\n");
+    }
+}
+
+sub message_location {
+    return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
+}
+
+sub add_messages {
+    my ($msg)=@_;
+    my $result=join(' ',
+		    @Apache::lonxml::info_messages,
+		    @Apache::lonxml::error_messages,
+		    @Apache::lonxml::warning_messages);
+    undef(@Apache::lonxml::info_messages);
+    undef(@Apache::lonxml::error_messages);
+    undef(@Apache::lonxml::warning_messages);
+    $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
+    $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
 }
 
 sub get_param {
@@ -1338,6 +1398,9 @@ sub get_param {
     if ( ! $context ) { $context = -1; }
     my $args ='';
     if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+    if ( ! $Apache::lonxml::usestyle ) {
+	$args=$Apache::lonxml::style_values.$args;
+    }
     if ( ! $args ) { return undef; }
     if ( $case_insensitive ) {
 	if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
@@ -1361,6 +1424,9 @@ sub get_param_var {
   if ( ! $context ) { $context = -1; }
   my $args ='';
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+  if ( ! $Apache::lonxml::usestyle ) {
+      $args=$Apache::lonxml::style_values.$args;
+  }
   &Apache::lonxml::debug("Args are $args param is $param");
   if ($case_insensitive) {
       if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {