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

Diff for /loncom/xml/lonxml.pm between versions 1.372 and 1.405

version 1.372, 2005/04/07 06:56:27 version 1.405, 2006/04/13 18:35:17
Line 52  use Math::Random(); Line 52  use Math::Random();
 use Opcode();  use Opcode();
 use POSIX qw(strftime);  use POSIX qw(strftime);
 use Time::HiRes qw( gettimeofday tv_interval );  use Time::HiRes qw( gettimeofday tv_interval );
   use Symbol();
   
 sub register {  sub register {
   my ($space,@taglist) = @_;    my ($space,@taglist) = @_;
Line 148  $Apache::lonxml::post_evaluate=1; Line 149  $Apache::lonxml::post_evaluate=1;
 #a header message to emit in the case of any generated warning or errors  #a header message to emit in the case of any generated warning or errors
 $Apache::lonxml::warnings_error_header='';  $Apache::lonxml::warnings_error_header='';
   
   #  Control whether or not LaTeX symbols should be substituted for their
   #  \ style equivalents...this may be turned off e.g. in an verbatim
   #  environment.
   
   $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
   
   sub enable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 1;
   }
   sub disable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 0;
   }
   
 sub xmlbegin {  sub xmlbegin {
     my ($style)=@_;      my ($style)=@_;
     my $output='';      my $output='';
Line 180  sub xmlend { Line 194  sub xmlend {
  $status=$Apache::inputtags::status[-1];    $status=$Apache::inputtags::status[-1]; 
     }      }
     my $discussion;      my $discussion;
     &Apache::loncommon::get_unprocessed_cgi      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
         ($env{'query_string'},['LONCAPA_INTERNAL_no_discussion']);     ['LONCAPA_INTERNAL_no_discussion']);
     if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) ||      if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) ||
         $env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {          $env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {
         $discussion=&Apache::lonfeedback::list_discussion($mode,$status);          $discussion=&Apache::lonfeedback::list_discussion($mode,$status);
Line 190  sub xmlend { Line 204  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.&Apache::loncommon::end_page();
 }  }
   
 sub tokeninputfield {  sub tokeninputfield {
Line 272  sub printtokenheader { Line 286  sub printtokenheader {
         $tcrsid=$courseid;          $tcrsid=$courseid;
     }      }
   
     my %reply=&Apache::lonnet::get('environment',      my $plainname=&Apache::loncommon::plainname($tuname,$tudom);
               ['firstname','middlename','lastname','generation'],  
               $tudom,$tuname);  
     my $plainname=$reply{'firstname'}.' '.   
                   $reply{'middlename'}.' '.  
                   $reply{'lastname'}.' '.  
   $reply{'generation'};  
   
     if ($target eq 'web') {      if ($target eq 'web') {
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));          my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
Line 369  sub xmlparse { Line 377  sub xmlparse {
  &initdepth();   &initdepth();
  &init_alarm();   &init_alarm();
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target);     $safeeval,\%style_for_target,1);
   
  if ($env{'request.uri'}) {   if ($env{'request.uri'}) {
     &writeallows($env{'request.uri'});      &writeallows($env{'request.uri'});
  }   }
  &do_registered_ssi();   &do_registered_ssi();
  if ($Apache::lonxml::counter_changed) { &store_counter() }   if ($Apache::lonxml::counter_changed) { &store_counter() }
   
    &clean_safespace($safeeval);
   
  if ($env{'form.return_only_error_and_warning_counts'}) {   if ($env{'form.return_only_error_and_warning_counts'}) {
      return "$errorcount:$warningcount";       return "$errorcount:$warningcount";
  }   }
  return $finaloutput;   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 {  sub latex_special_symbols {
     my ($string,$where)=@_;      my ($string,$where)=@_;
       #
       #  If e.g. in verbatim mode, then don't substitute.
       #  but return original string.
       #
       if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
    return $string;
       }
     if ($where eq 'header') {      if ($where eq 'header') {
  $string =~ s/(\\|_|\^)/ /g;   $string =~ s/(\\|_|\^)/ /g;
  $string =~ s/(\$|%|\{|\})/\\$1/g;   $string =~ s/(\$|%|\{|\})/\\$1/g;
Line 424  sub latex_special_symbols { Line 415  sub latex_special_symbols {
  $string=~s/\\\%|\%/\\\%/g;   $string=~s/\\\%|\%/\\\%/g;
  $string=~s/\\{|{/\\{/g;   $string=~s/\\{|{/\\{/g;
  $string=~s/\\}|}/\\}/g;   $string=~s/\\}|}/\\}/g;
    $string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
  $string=~s/\\\$|\$/\\\$/g;   $string=~s/\\\$|\$/\\\$/g;
  $string=~s/\\\_|\_/\\\_/g;   $string=~s/\\\_|\_/\\\_/g;
         $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;          $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;
Line 439  sub latex_special_symbols { Line 431  sub latex_special_symbols {
 }  }
   
 sub inner_xmlparse {  sub inner_xmlparse {
   my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
   my $finaloutput = '';    my $finaloutput = '';
   my $result;    my $result;
   my $token;    my $token;
   my $dontpop=0;    my $dontpop=0;
     my $startredirection = $Apache::lonxml::redirection;
   while ( $#$pars > -1 ) {    while ( $#$pars > -1 ) {
     while ($token = $$pars['-1']->get_token) {      while ($token = $$pars['-1']->get_token) {
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
Line 553  sub inner_xmlparse { Line 546  sub inner_xmlparse {
   #   $finaloutput.=&endredirection;    #   $finaloutput.=&endredirection;
   # }    # }
   
     if ( $start && $target eq 'grade') { &endredirection(); }
     if ( $Apache::lonxml::redirection > $startredirection) {
         while ($Apache::lonxml::redirection > $startredirection) {
     $finaloutput .= &endredirection();
         }
     }
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }        }    
Line 651  sub setup_globals { Line 649  sub setup_globals {
   @Apache::lonxml::ssi_info=();    @Apache::lonxml::ssi_info=();
   $Apache::lonxml::post_evaluate=1;    $Apache::lonxml::post_evaluate=1;
   $Apache::lonxml::warnings_error_header='';    $Apache::lonxml::warnings_error_header='';
     $Apache::lonxml::substitute_LaTeX_symbols = 1;
   if ($target eq 'meta') {    if ($target eq 'meta') {
     $Apache::lonxml::redirection = 0;      $Apache::lonxml::redirection = 0;
     $Apache::lonxml::metamode = 1;      $Apache::lonxml::metamode = 1;
Line 662  sub setup_globals { Line 661  sub setup_globals {
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
   } elsif ($target eq 'grade') {    } elsif ($target eq 'grade') {
     &startredirection;      &startredirection(); #ended in inner_xmlparse on exit
     $Apache::lonxml::metamode = 0;      $Apache::lonxml::metamode = 0;
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
Line 691  sub setup_globals { Line 690  sub setup_globals {
   
 sub init_safespace {  sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;    my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->deny_only(':dangerous');
     $safeeval->reval('use Math::Complex;');
     $safeeval->permit_only(":default");
   $safeeval->permit("entereval");    $safeeval->permit("entereval");
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
Line 748  sub init_safespace { Line 750  sub init_safespace {
   $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );    $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
   $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');    $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::new_fract,$safeeval,'&new_fract');
 #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');  #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
 #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');  #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
Line 784  sub init_safespace { Line 816  sub init_safespace {
 # $safeeval->deny(":base_orig");  # $safeeval->deny(":base_orig");
   $safeeval->permit("require");    $safeeval->permit("require");
   $safeinit .= ';$external::target="'.$target.'";';    $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);    &Apache::run::run($safeinit,$safeeval);
     &initialize_rndseed($safeeval);
   }
   
   sub clean_safespace {
       my ($safeeval) = @_;
       delete_package_recurse($safeeval->{Root});
   }
   
   sub delete_package_recurse {
        my ($package) = @_;
        my @subp;
        {
    no strict 'refs';
    while (my ($key,$val) = each(%{*{"$package\::"}})) {
        if (!defined($val)) { next; }
        local (*ENTRY) = $val;
        if (defined *ENTRY{HASH} && $key =~ /::$/ &&
    $key ne "main::" && $key ne "<none>::")
        {
    my ($p) = $package ne "main" ? "$package\::" : "";
    ($p .= $key) =~ s/::$//;
    push(@subp,$p);
        }
    }
        }
        foreach my $p (@subp) {
    delete_package_recurse($p);
        }
        Symbol::delete_package($package);
   }
   
   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 {  sub default_homework_load {
Line 839  sub startredirection { Line 904  sub startredirection {
   
 sub endredirection {  sub endredirection {
     if (!$Apache::lonxml::redirection) {      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 '';   return '';
     }      }
     $Apache::lonxml::redirection--;      $Apache::lonxml::redirection--;
Line 906  sub decreasedepth { Line 971  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 914  sub get_all_text_unbalanced { Line 989  sub get_all_text_unbalanced {
     $tag='<'.$tag.'>';      $tag='<'.$tag.'>';
     while ($token = $$pars[-1]->get_token) {      while ($token = $$pars[-1]->get_token) {
  if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {   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') {   } elsif ($token->[0] eq 'PI') {
     $result.=$token->[2];      $result.=$token->[2];
  } elsif ($token->[0] eq 'S') {   } elsif ($token->[0] eq 'S') {
Line 945  sub increment_counter { Line 1024  sub increment_counter {
 }  }
   
 sub init_counter {  sub init_counter {
     if (defined($env{'form.counter'})) {      if ($env{'request.state'} eq 'construct') {
    $Apache::lonxml::counter=1;
    $Apache::lonxml::counter_changed=1;
       } elsif (defined($env{'form.counter'})) {
  $Apache::lonxml::counter=$env{'form.counter'};   $Apache::lonxml::counter=$env{'form.counter'};
  $Apache::lonxml::counter_changed=0;   $Apache::lonxml::counter_changed=0;
     } else {      } else {
Line 956  sub init_counter { Line 1038  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 980  sub get_all_text { Line 1089  sub get_all_text {
     while (($depth >=0) && ($token = $$pars[-1]->get_token)) {      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
  #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);   #&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')) {   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') {   } elsif ($token->[0] eq 'PI') {
     $result.=$token->[2];      $result.=$token->[2];
  } elsif ($token->[0] eq 'S') {   } elsif ($token->[0] eq 'S') {
Line 1032  sub get_all_text { Line 1145  sub get_all_text {
  #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");   #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
  if (($token->[0] eq 'T')||($token->[0] eq 'C')||   if (($token->[0] eq 'T')||($token->[0] eq 'C')||
     ($token->[0] eq 'D')) {      ($token->[0] eq 'D')) {
     $result.=$token->[1];      if ($token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $result.=$token->[1];
       }
  } elsif ($token->[0] eq 'PI') {   } elsif ($token->[0] eq 'PI') {
     $result.=$token->[2];      $result.=$token->[2];
  } elsif ($token->[0] eq 'S') {   } elsif ($token->[0] eq 'S') {
Line 1085  sub parstring { Line 1202  sub parstring {
   return $temp;    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 {  sub writeallows {
     unless ($#extlinks>=0) { return; }      unless ($#extlinks>=0) { return; }
     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);      my $thisurl = &Apache::lonnet::clutter(shift);
     if ($env{'httpref.'.$thisurl}) {      if ($env{'httpref.'.$thisurl}) {
  $thisurl=$env{'httpref.'.$thisurl};   $thisurl=$env{'httpref.'.$thisurl};
     }      }
Line 1169  sub createnewhtml { Line 1294  sub createnewhtml {
     my $title=&mt('Title of document goes here');      my $title=&mt('Title of document goes here');
     my $body=&mt('Body of document goes here');      my $body=&mt('Body of document goes here');
     my $filecontents=(<<SIMPLECONTENT);      my $filecontents=(<<SIMPLECONTENT);
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml/11/DTD/xhtml11.dtd">  
 <html>  <html>
 <head>  <head>
 <title>$title</title>  <title>$title</title>
Line 1233  FULLPAGE Line 1357  FULLPAGE
   $xml_help=&Apache::loncommon::helpLatexCheatsheet();    $xml_help=&Apache::loncommon::helpLatexCheatsheet();
       }        }
       my $cleanbut = '';        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 $titledisplay=&display_title();
       my %lt=&Apache::lonlocal::texthash('st' => 'Save this',        my %lt=&Apache::lonlocal::texthash('st' => 'Save this',
  'vi' => 'View',   'vi' => 'View',
Line 1324  sub handler { Line 1445  sub handler {
 # Edit action? Save file.  # Edit action? Save file.
 #  #
     unless ($env{'request.state'} eq 'published') {      unless ($env{'request.state'} eq 'published') {
  if (($env{'form.savethisfile'}) || ($env{'form.attemptclean'})) {   if ($env{'form.savethisfile'}) {
     if (&storefile($file,$env{'form.filecont'})) {      if (&storefile($file,$env{'form.filecont'})) {
  &Apache::lonxml::info("<font COLOR=\"#0000FF\">".   &Apache::lonxml::info("<font COLOR=\"#0000FF\">".
       &mt('Updated').": ".        &mt('Updated').": ".
Line 1337  sub handler { Line 1458  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('File Error');
  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 1361  ENDNOTFOUND Line 1478  ENDNOTFOUND
     } else {      } else {
  unless ($env{'request.state'} eq 'published') {   unless ($env{'request.state'} eq 'published') {
     if ($filecontents=~/BEGIN LON-CAPA Internal/) {      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.'));   &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);  
     }      }
 #  #
 # we are in construction space, see if edit mode forced  # we are in construction space, see if edit mode forced
             &Apache::loncommon::get_unprocessed_cgi              &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                           ($ENV{'QUERY_STRING'},['editmode']);      ['editmode']);
  }   }
  if (!$env{'form.editmode'} || $env{'form.viewmode'}) {   if (!$env{'form.editmode'} || $env{'form.viewmode'}) {
     $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,      $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
  '',%mystyle);   '',%mystyle);
     undef($Apache::lonhomework::parsing_a_task);      undef($Apache::lonhomework::parsing_a_task);
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
       ['rawmode']);
       if ($env{'form.rawmode'}) { $result = $filecontents; }
  }   }
     }      }
           
Line 1386  ENDNOTFOUND Line 1502  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';
    $options{'only_body'} = 1;
     }      }
     $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 1423  sub debug { Line 1542  sub debug {
     if ($Apache::lonxml::debug eq "1") {      if ($Apache::lonxml::debug eq "1") {
  $|=1;   $|=1;
  my $request=$Apache::lonxml::request;   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");   $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
  #&Apache::lonnet::logthis($_[0]);   #&Apache::lonnet::logthis($_[0]);
     }      }
Line 1455  sub error { Line 1579  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 $msg = join('<br />',@_);
  #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 $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
     my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);      my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
     my $declutter=&Apache::lonnet::declutter($env{'request.filename'});      my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
     my @userlist;      my @userlist;
     foreach (keys %users) {      foreach (keys %users) {
  my ($user,$domain) = split(/:/, $_);   my ($user,$domain) = split(/:/, $_);
  push(@userlist,"$user\@$domain");   push(@userlist,"$user\@$domain");
  &Apache::lonmsg::user_normal_msg($user,$domain,   my $key=$declutter.'_'.$user.'_'.$domain;
  "Error [$declutter]",join('<br />',@_));   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]",$msg);
       &Apache::lonnet::put('nohist_xmlerrornotifications',
    {$key => $now},
    $cdom,$cnum);
    }
     }      }
     if ($env{'request.role.adv'}) {      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));   $errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
Line 1484  sub warning { Line 1621  sub warning {
       
     if ($env{'form.grade_target'} ne 'tex') {      if ($env{'form.grade_target'} ne 'tex') {
  if ( &show_error_warn_msg() ) {   if ( &show_error_warn_msg() ) {
     my $request=$Apache::lonxml::request;  
     if (!$request) { $request=Apache->request; }  
     push(@Apache::lonxml::warning_messages,      push(@Apache::lonxml::warning_messages,
  $Apache::lonxml::warnings_error_header.   $Apache::lonxml::warnings_error_header.
  "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");   "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
Removed from v.1.372  
changed lines
  Added in v.1.405

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