--- loncom/xml/lonxml.pm 2003/11/11 16:48:11 1.292 +++ loncom/xml/lonxml.pm 2004/04/15 20:18:46 1.317 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.292 2003/11/11 16:48:11 sakharuk Exp $ +# $Id: lonxml.pm,v 1.317 2004/04/15 20:18:46 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,30 +36,11 @@ # The C source of the Code may not be distributed by the Licensee # to any other parties under any circumstances. # -# last modified 06/26/00 by Alexander Sakharuk -# 11/6 Gerd Kortemeyer -# 6/1/1 Gerd Kortemeyer -# 2/21,3/13 Guy -# 3/29,5/4 Gerd Kortemeyer -# 5/26 Gerd Kortemeyer -# 5/27 H. K. Ng -# 6/2,6/3,6/8,6/9 Gerd Kortemeyer -# 6/12,6/13 H. K. Ng -# 6/16 Gerd Kortemeyer -# 7/27 H. K. Ng -# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer -# Guy Albertelli -# 9/26 Gerd Kortemeyer -# Dec Guy Albertelli -# YEAR=2002 -# 1/1 Gerd Kortemeyer -# 1/2 Matthew Hall -# 1/3 Gerd Kortemeyer -# + 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 +122,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 +145,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 +170,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,20 +379,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; - $string=~s/(&[^A-Za-z\#])/\\$1/g; - $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; } @@ -474,7 +460,7 @@ sub inner_xmlparse { #clear out any tags that didn't end while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { my $lasttag=$$stack[-1]; - if ($token->[1] =~ /^$lasttag$/i) { + if ($token->[1] =~ /^\Q$lasttag\E$/i) { &Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>'); last; } else { @@ -509,10 +495,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 { @@ -623,6 +605,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; @@ -743,6 +726,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"); @@ -753,6 +738,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 { @@ -838,7 +845,7 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)\Q$tag\E(.*)/s) { + if ($result =~ /(.*)\Q$tag\E(.*)/is) { &Apache::lonxml::debug('Got a winner with leftovers ::'.$2); &Apache::lonxml::debug('Result is :'.$1); $result=$1; @@ -900,12 +907,12 @@ sub get_all_text { } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { - if ($token->[1] =~ /^$tag$/i) { $depth++; } - if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } - if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } + if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } $result.=$token->[4]; } elsif ($token->[0] eq 'E') { - if ( $token->[1] =~ /^$tag$/i) { $depth--; } + if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; } #skip sending back the last end tag if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) { my $string= @@ -934,7 +941,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; @@ -952,13 +959,13 @@ sub get_all_text { } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { - if ( $token->[1] =~ /^$tag$/i) { + if ( $token->[1] =~ /^\Q$tag\E$/i) { $$pars[-1]->unget_token($token); last; } else { $result.=$token->[4]; } - if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; } - if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } + if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } @@ -1040,7 +1047,7 @@ sub afterburn { my $anchorname=$_; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; - $result=~s/($matchthis)/\$1\<\/font\>/gs; + $result=~s/(\Q$matchthis\E)/\$1\<\/font\>/gs; } } if ($ENV{'form.link'}) { @@ -1048,14 +1055,14 @@ sub afterburn { my ($anchorname,$linkurl)=split(/\>/,$_); my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; - $result=~s/($matchthis)/\$1\<\/a\>/gs; + $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/gs; } } if ($ENV{'form.anchor'}) { my $anchorname=$ENV{'form.anchor'}; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; - $result=~s/($matchthis)/\$1\<\/a\>/s; + $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/s; $result.=(<<"ENDSCRIPT");