[BACK]Return to lonxml.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.304 and 1.315

version 1.304, 2004/03/02 20:59:24 version 1.315, 2004/03/31 05:24:00
Line 59 Line 59
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   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 strict;
 use HTML::LCParser();  use HTML::LCParser();
 use HTML::TreeBuilder();  use HTML::TreeBuilder();
Line 141  $evaluate = 1; Line 141  $evaluate = 1;
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @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  # has the dynamic menu been updated to know about this resource
 $Apache::lonxml::registered=0;  $Apache::lonxml::registered=0;
   
Line 401  sub latex_special_symbols { Line 398  sub latex_special_symbols {
     my ($string,$where)=@_;      my ($string,$where)=@_;
     if ($where eq 'header') {      if ($where eq 'header') {
  $string =~ s/(\\|_|\^)/ /g;   $string =~ s/(\\|_|\^)/ /g;
  $string =~ s/(\$|%|\#|&|\{|\})/\\$1/g;   $string =~ s/(\$|%|\{|\})/\\$1/g;
  $string =~ s/_/ /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 {      } else {
  $string=~s/\\ /\\char92 /g;   $string=~s/\\/\\ensuremath{\\backslash}/g;
  $string=~s/\^/\\\^\\strut /g;   $string=~s/([^\\]|^)\%/$1\\\%/g;
  $string=~s/\~/\\char126 /g;   $string=~s/([^\\]|^)(\$|_)/$1\\$2/g;
  #fixup & if it doesn't look like   $string=~s/\$\$/\$\\\$/g;
         # { or α   $string=~s/\#\#/\#\\\#/g;
  $string=~s/(&(?!((\#[0-9]+)|([a-z]+));))/\\$1/gi;          $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;
         $string=~s/([^&\\])\#/$1\\#/g;   $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less
  $string=~s/\#\#/\#\\#/g;   $string=&Apache::lonprintout::character_chart($string);
  $string=~s/(\$|_|{|})/\\$1/g;   # any & or # leftover should be safe to just escape
  $string=~s/\\char92 /\\texttt{\\char92}/g;          $string=~s/([^\\]|^)\&/$1\\\&/g;
  $string=~s/(>|<)/\$$1\$/g; #more or less          $string=~s/([^\\]|^)\#/$1\\\#/g;
  if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit  #single { or } How to escape?
  if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space  
  if ($string eq '%.') {$string = '\%.';} #percent at the end of statement  
     }      }
     return $string;      return $string;
 }  }
Line 515  sub inner_xmlparse { Line 514  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) {        if ($Apache::lonxml::redirection) {
  $Apache::lonxml::outputstack['-1'] .= $result;   $Apache::lonxml::outputstack['-1'] .= $result;
       } else {        } else {
Line 750  sub init_safespace { Line 745  sub init_safespace {
   $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');    $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_get_seed,$safeeval,'&random_get_seed');
   $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_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  #need to inspect this class of ops
 # $safeeval->deny(":base_orig");  # $safeeval->deny(":base_orig");
Line 765  sub init_safespace { Line 762  sub init_safespace {
 sub __LC_INTERNAL_EVALUATE__ {  sub __LC_INTERNAL_EVALUATE__ {
     my ($__LC__a,$__LC__b,$__LC__c)=@_;      my ($__LC__a,$__LC__b,$__LC__c)=@_;
     my $__LC__prefix;      my $__LC__prefix;
     my $__LC__msg;  
     while(1){      while(1){
  {    { 
     use strict;      use strict;
       no strict "vars";
     if (eval(defined(eval($__LC__a.$__LC__b)))) {      if (eval(defined(eval($__LC__a.$__LC__b)))) {
  return $__LC__msg.$__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c);   return $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c);
     }      }
  }   }
  $__LC__prefix.=substr($__LC__a,0,1,"");   $__LC__prefix.=substr($__LC__a,0,1,"");
  if ($__LC__a!~/^(\$|&|\#)/) { last; }   if ($__LC__a!~/^(\$|&|\#)/) { last; }
     }      }
     return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c.$__LC__msg;      return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c;
 }  }
 EVALUATESUB  EVALUATESUB
     $safeeval->permit("require");      $safeeval->permit("require");
Line 963  sub get_all_text { Line 960  sub get_all_text {
     #never found the end tag ran out of text, throw error send back blank      #never found the end tag ran out of text, throw error send back blank
     &error('Never found end tag for &lt;'.$tag.      &error('Never found end tag for &lt;'.$tag.
    '&gt; current string <pre>'.     '&gt; current string <pre>'.
    &HTML::Entities::encode($result).     &HTML::Entities::encode($result,'<>&"').
    '</pre>');     '</pre>');
     if ($gotfullstack) {      if ($gotfullstack) {
  my $newstring='</'.$tag.'>'.$result;   my $newstring='</'.$tag.'>'.$result;
Line 1140  SIMPLECONTENT Line 1137  SIMPLECONTENT
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents,$filetype)=@_;        my ($result,$filecontents,$filetype)=@_;
       $filecontents = &HTML::Entities::encode($filecontents);        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  #      my $editheader='<a href="#editsection">Edit below</a><hr />';
       my $xml_help = '';        my $xml_help = '';
       if ($filetype eq 'html') {        if ($filetype eq 'html') {
Line 1236  sub handler { Line 1233  sub handler {
     unless ($ENV{'request.state'} eq 'published') {      unless ($ENV{'request.state'} eq 'published') {
  if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {   if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {
     if (&storefile($file,$ENV{'form.filecont'})) {      if (&storefile($file,$ENV{'form.filecont'})) {
  $request->print("<font COLOR=\"#0000FF\">".&mt('Updated').": ".   &Apache::lonxml::info("<font COLOR=\"#0000FF\">".
 &Apache::lonlocal::locallocaltime(time)." </font>");        &mt('Updated').": ".
         &Apache::lonlocal::locallocaltime(time).
         " </font>");
     }       } 
  }   }
     }      }
Line 1289  ENDNOTFOUND Line 1288  ENDNOTFOUND
  if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {   if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
     my $displayfile=$request->uri;      my $displayfile=$request->uri;
     $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
     $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.      $result='<html><body bgcolor="#FFFFFF">'.
    &Apache::lonxml::message_location().'<h3>'.
    $displayfile.
  '</h3></body></html>';   '</h3></body></html>';
     $result=&inserteditinfo($result,$filecontents,$filetype);      $result=&inserteditinfo($result,$filecontents,$filetype);
  }   }
Line 1297  ENDNOTFOUND Line 1298  ENDNOTFOUND
     if ($filetype eq 'html') { writeallows($request->uri); }      if ($filetype eq 'html') { writeallows($request->uri); }
   
           
       &Apache::lonxml::add_messages(\$result);
     $request->print($result);      $request->print($result);
           
     return OK;      return OK;
Line 1321  sub debug { Line 1322  sub debug {
  $|=1;   $|=1;
  my $request=$Apache::lonxml::request;   my $request=$Apache::lonxml::request;
  if (!$request) { $request=Apache->request; }   if (!$request) { $request=Apache->request; }
  $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0])."</pre></font>\n");   $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
     }      }
 }  }
   
Line 1331  sub error { Line 1332  sub error {
   if (!$request) { $request=Apache->request; }    if (!$request) { $request=Apache->request; }
   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {    if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
     # If printing in construction space, put the error inside <pre></pre>      # If printing in construction space, put the error inside <pre></pre>
       $request->print($Apache::lonxml::warnings_error_header.        push(@Apache::lonxml::error_messages,
       "<b>ERROR:</b>".join("\n",@_)."\n");     $Apache::lonxml::warnings_error_header.
      "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");
       $Apache::lonxml::warnings_error_header='';        $Apache::lonxml::warnings_error_header='';
   } else {    } else {
     $request->print("<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />");        push(@Apache::lonxml::error_messages,
      "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />");
     #notify author      #notify author
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));      &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
     #notify course      #notify course
Line 1358  sub warning { Line 1361  sub warning {
  if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {   if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
     my $request=$Apache::lonxml::request;      my $request=$Apache::lonxml::request;
     if (!$request) { $request=Apache->request; }      if (!$request) { $request=Apache->request; }
     $request->print($Apache::lonxml::warnings_error_header.      push(@Apache::lonxml::warning_messages,
       "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");   $Apache::lonxml::warnings_error_header.
    "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
     $Apache::lonxml::warnings_error_header='';      $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('<br />',@_)."<br />\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 {  sub get_param {
     my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;      my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
     if ( ! $context ) { $context = -1; }      if ( ! $context ) { $context = -1; }
Removed from v.1.304  
changed lines
  Added in v.1.315

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>