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

Diff for /loncom/xml/lonxml.pm between versions 1.397 and 1.419

version 1.397, 2006/02/05 18:30:56 version 1.419, 2006/09/26 04:26:15
Line 40 Line 40
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount @htmlareafields);  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 123  $evaluate = 1; Line 123  $evaluate = 1;
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
 # has the dynamic menu been updated to know about this resource  
 $Apache::lonxml::registered=0;  
   
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
   
Line 162  sub disable_LaTeX_substitutions { Line 159  sub disable_LaTeX_substitutions {
     $Apache::lonxml::substitute_LaTeX_symbols = 0;      $Apache::lonxml::substitute_LaTeX_symbols = 0;
 }  }
   
 sub xmlbegin {  
     my ($style)=@_;  
     my $output='';  
     @htmlareafields=();  
     if ($env{'browser.mathml'}) {  
  $output='<?xml version="1.0"?>'  
             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"  
 #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '  
               
 #    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'  
     .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'  
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '   
     .'xmlns="http://www.w3.org/1999/xhtml">';  
     } else {  
  $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';  
     }  
     if ($style eq 'encode') {  
  $output=&HTML::Entities::encode($output,'<>&"');  
     }  
     return $output;  
 }  
   
 sub xmlend {  sub xmlend {
     my ($target,$parser)=@_;      my ($target,$parser)=@_;
     my $mode='xml';      my $mode='xml';
Line 204  sub xmlend { Line 179  sub xmlend {
  $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';   $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
  &Apache::lonxml::newparser($parser,\$discussion,'');   &Apache::lonxml::newparser($parser,\$discussion,'');
  return '';   return '';
     } else {  
  return $discussion.&Apache::loncommon::endbodytag();  
     }      }
   
       return $discussion;
 }  }
   
 sub tokeninputfield {  sub tokeninputfield {
Line 304  sub printtokenheader { Line 279  sub printtokenheader {
     }      }
 }  }
   
 sub fontsettings {  
     my $headerstring='';  
     if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {   
  $headerstring.=  
     '<meta Content-Type="text/html; charset=x-mac-roman" />';  
     } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {  
  $headerstring.=  
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';  
     }  
     return $headerstring;  
 }  
   
 sub printalltags {  sub printalltags {
   my $temp;    my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach $temp (sort keys %Apache::lonxml::alltags) {
Line 403  sub latex_special_symbols { Line 366  sub latex_special_symbols {
  return $string;   return $string;
     }      }
     if ($where eq 'header') {      if ($where eq 'header') {
  $string =~ s/(\\|_|\^)/ /g;   $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
  $string =~ s/(\$|%|\{|\})/\\$1/g;   $string =~ s/(\$|%|\{|\})/\\$1/g;
  $string =~ s/_/ /g;  
  $string=&Apache::lonprintout::character_chart($string);   $string=&Apache::lonprintout::character_chart($string);
  # any & or # leftover should be safe to just escape   # any & or # leftover should be safe to just escape
         $string=~s/([^\\])\&/$1\\\&/g;          $string=~s/([^\\])\&/$1\\\&/g;
         $string=~s/([^\\])\#/$1\\\#/g;          $string=~s/([^\\])\#/$1\\\#/g;
    $string =~ s/_/\\_/g;              # _ -> \_
    $string =~ s/\^/\\\^{}/g;          # ^ -> \^{} 
     } else {      } else {
  $string=~s/\\/\\ensuremath{\\backslash}/g;   $string=~s/\\/\\ensuremath{\\backslash}/g;
  $string=~s/\\\%|\%/\\\%/g;   $string=~s/\\\%|\%/\\\%/g;
Line 637  sub callsub { Line 601  sub callsub {
 sub setup_globals {  sub setup_globals {
   my ($request,$target)=@_;    my ($request,$target)=@_;
   $Apache::lonxml::request=$request;    $Apache::lonxml::request=$request;
   $Apache::lonxml::registered = 0;  
   @Apache::lonxml::htmlareafields=();  
   $errorcount=0;    $errorcount=0;
   $warningcount=0;    $warningcount=0;
   $Apache::lonxml::default_homework_loaded=0;    $Apache::lonxml::default_homework_loaded=0;
Line 971  sub decreasedepth { Line 933  sub decreasedepth {
 #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";  #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 &quot;<tt>_</tt>&quot; or &quot;<tt>.</tt>&quot;"));
       }
       if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
       return $id;
   }
   
 sub get_all_text_unbalanced {  sub get_all_text_unbalanced {
 #there is a copy of this in lonpublisher.pm  #there is a copy of this in lonpublisher.pm
     my($tag,$pars)= @_;      my($tag,$pars)= @_;
Line 1028  sub init_counter { Line 1000  sub init_counter {
   
 sub store_counter {  sub store_counter {
     &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));      &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
       $Apache::lonxml::counter_changed=0;
     return '';      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 {  sub get_all_text {
     my($tag,$pars,$style)= @_;      my($tag,$pars,$style)= @_;
     my $gotfullstack=1;      my $gotfullstack=1;
Line 1150  sub newparser { Line 1149  sub newparser {
 }  }
   
 sub parstring {  sub parstring {
   my ($token) = @_;      my ($token) = @_;
   my $temp='';      my (@vars,@values);
   foreach (@{$token->[3]}) {      foreach my $attr (@{$token->[3]}) {
     unless ($_=~/\W/) {   if ($attr!~/\W/) {
       my $val=$token->[2]->{$_};      my $val=$token->[2]->{$attr};
       $val =~ s/([\%\@\\\"\'])/\\$1/g;      $val =~ s/([\%\@\\\"\'])/\\$1/g;
       $val =~ s/(\$[^{a-zA-Z_])/\\$1/g;      $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
       $val =~ s/(\$)$/\\$1/;      $val =~ s/(\$)$/\\$1/;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }      #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";";      push(@vars,"\$$attr");
     }      push(@values,"\"$val\"");
   }   }
   return $temp;      }
       my $var_init = 
    (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');'
           : '';
       return $var_init;
 }  }
   
 sub extlink {  sub extlink {
Line 1290  sub inserteditinfo { Line 1293  sub inserteditinfo {
       my $initialize='';        my $initialize='';
       if ($filetype eq 'html') {        if ($filetype eq 'html') {
   my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();    my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
   $initialize=&Apache::lonhtmlcommon::htmlareaheaders().    $initialize=&Apache::lonhtmlcommon::spellheader();
       &Apache::lonhtmlcommon::spellheader();  
   if (!&Apache::lonhtmlcommon::htmlareablocked() &&    if (!&Apache::lonhtmlcommon::htmlareablocked() &&
       &Apache::lonhtmlcommon::htmlareabrowser()) {        &Apache::lonhtmlcommon::htmlareabrowser()) {
       $initialize.=(<<FULLPAGE);        $initialize.=(<<FULLPAGE);
Line 1421  sub handler { Line 1423  sub handler {
     my $result = '';      my $result = '';
     my $filecontents=&Apache::lonnet::getfile($file);      my $filecontents=&Apache::lonnet::getfile($file);
     if ($filecontents eq -1) {      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();
  my $fnf=&mt('File not found');   my $fnf=&mt('File not found');
  $result=(<<ENDNOTFOUND);   $result=(<<ENDNOTFOUND);
 <html>  $start_page
 <head>  
 <title>$fnf</title>  
 </head>  
 $bodytag  
 <b>$fnf: $file</b>  <b>$fnf: $file</b>
 </body>  $end_page
 </html>  
 ENDNOTFOUND  ENDNOTFOUND
         $filecontents='';          $filecontents='';
  if ($env{'request.state'} ne 'published') {   if ($env{'request.state'} ne 'published') {
Line 1469  ENDNOTFOUND Line 1467  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/^\/[^\/]*//;
     my $bodytag='<body bgcolor="#FFFFFF">';      my %options = ();
     if ($env{'environment.remote'} eq 'off') {      if ($env{'environment.remote'} ne 'off') {
  $bodytag=&Apache::loncommon::bodytag();   $options{'bgcolor'}   = '#FFFFFF';
     }      }
     $result='<html>'.$bodytag.      my $start_page = &Apache::loncommon::start_page(undef,undef,
       \%options);
       $result=$start_page.
  &Apache::lonxml::message_location().'<h3>'.   &Apache::lonxml::message_location().'<h3>'.
  $displayfile.   $displayfile.
  '</h3></body></html>';   '</h3>'.&Apache::loncommon::end_page();
     $result=&inserteditinfo($result,$filecontents,$filetype);      $result=&inserteditinfo($result,$filecontents,$filetype);
  }   }
     }      }
     if ($filetype eq 'html') { writeallows($request->uri); }      if ($filetype eq 'html') { &writeallows($request->uri); }
   
           
     &Apache::lonxml::add_messages(\$result);      &Apache::lonxml::add_messages(\$result);
Line 1543  sub error { Line 1543  sub error {
  if ( !$symb ) {   if ( !$symb ) {
     #public or browsers      #public or browsers
     $errormsg=&mt("An error occured while processing this resource. The author has been notified.");      $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
  }    }
    my $host=$Apache::lonnet::perlvar{'lonHostID'};
    my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));
  #notify author   #notify author
  &Apache::lonmsg::author_res_msg($env{'request.filename'},join('<br />',@_));   &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
  #notify course   #notify course
  if ( $symb && $env{'request.course.id'} ) {   if ( $symb && $env{'request.course.id'} ) {
     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
Line 1563  sub error { Line 1565  sub error {
  my $now=time;   my $now=time;
  if ($now-$lastnotified{$key}>86400) {   if ($now-$lastnotified{$key}>86400) {
     &Apache::lonmsg::user_normal_msg($user,$domain,      &Apache::lonmsg::user_normal_msg($user,$domain,
  "Error [$declutter]",join('<br />',@_));   "Error [$declutter]",$msg);
     &Apache::lonnet::put('nohist_xmlerrornotifications',      &Apache::lonnet::put('nohist_xmlerrornotifications',
  {$key => $now},   {$key => $now},
  $cdom,$cnum);   $cdom,$cnum);
Line 1626  sub get_param { Line 1628  sub get_param {
     }      }
     if ( ! $args ) { return undef; }      if ( ! $args ) { return undef; }
     if ( $case_insensitive ) {      if ( $case_insensitive ) {
  if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {   if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
     return undef;      return undef;
  }   }
     } else {      } else {
  if ( $args =~ /my \$\Q$param\E=\"/ ) {   if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
Line 1652  sub get_param_var { Line 1654  sub get_param_var {
   }    }
   &Apache::lonxml::debug("Args are $args param is $param");    &Apache::lonxml::debug("Args are $args param is $param");
   if ($case_insensitive) {    if ($case_insensitive) {
       if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {        if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
   return undef;    return undef;
       }        }
   } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }    } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
   my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'    my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
   &Apache::lonxml::debug("first run is $value");    &Apache::lonxml::debug("first run is $value");
   if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {    if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
Removed from v.1.397  
changed lines
  Added in v.1.419

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