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

Diff for /loncom/xml/lonxml.pm between versions 1.148 and 1.339

version 1.148, 2002/01/09 09:50:59 version 1.339, 2004/10/05 18:51:50
Line 36 Line 36
 # The C source of the Code may not be distributed by the Licensee  # The C source of the Code may not be distributed by the Licensee
 # to any other parties under any circumstances.  # 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/10 Scott Harrison  
 # 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;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount @htmlareafields);
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::LCParser();
 use HTML::TreeBuilder;  use HTML::TreeBuilder();
 use Safe;  use HTML::Entities();
 use Safe::Hole;  use Safe();
 use Math::Cephes qw(:trigs :hypers :bessels erf erfc);  use Safe::Hole();
 use Math::Random qw(:all);  use Math::Cephes();
 use Opcode;  use Math::Random();
   use Opcode();
   use POSIX qw(strftime);
   use Time::HiRes qw( gettimeofday tv_interval );
   
 sub register {  sub register {
   my ($space,@taglist) = @_;    my ($space,@taglist) = @_;
Line 89  sub deregister { Line 72  sub deregister {
 }  }
   
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lontexconvert;  use Apache::lontexconvert();
 use Apache::style;  use Apache::style();
 use Apache::run;  use Apache::run();
 use Apache::londefdef;  use Apache::londefdef();
 use Apache::scripttag;  use Apache::scripttag();
 use Apache::edit;  use Apache::languagetags();
 use Apache::lonnet;  use Apache::edit();
 use Apache::File;  use Apache::inputtags();
 use Apache::loncommon;  use Apache::outputtags();
   use Apache::lonnet();
   use Apache::File();
   use Apache::loncommon();
   use Apache::lonfeedback();
   use Apache::lonmsg();
   use Apache::loncacc();
   use Apache::lonlocal;
   
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
 #debugging control, to turn on debugging modify the correct handler  #debugging control, to turn on debugging modify the correct handler
 $Apache::lonxml::debug=0;  $Apache::lonxml::debug=0;
   
   # keeps count of the number of warnings and errors generated in a parse
   $warningcount=0;
   $errorcount=0;
   
 #path to the directory containing the file currently being processed  #path to the directory containing the file currently being processed
 @pwd=();  @pwd=();
   
Line 131  $evaluate = 1; Line 125  $evaluate = 1;
 # 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;
   
   # a pointer the the Apache request object
   $Apache::lonxml::request='';
   
   # a problem number counter, and check on ether it is used
   $Apache::lonxml::counter=1;
   $Apache::lonxml::counter_changed=0;
   
   #internal check on whether to look at style defs
   $Apache::lonxml::usestyle=1;
   
   #locations used to store the parameter string for style substitutions
   $Apache::lonxml::style_values='';
   $Apache::lonxml::style_end_values='';
   
   #array of ssi calls that need to occur after we are done parsing
   @Apache::lonxml::ssi_info=();
   
   #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 {  sub xmlbegin {
   my $output='';    my $output='';
     @htmlareafields=();
   if ($ENV{'browser.mathml'}) {    if ($ENV{'browser.mathml'}) {
       $output='<?xml version="1.0"?>'        $output='<?xml version="1.0"?>'
             .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'              .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
Line 147  sub xmlbegin { Line 165  sub xmlbegin {
 }  }
   
 sub xmlend {  sub xmlend {
     my $discussion='';      my ($target,$parser)=@_;
     if ($ENV{'request.course.id'}) {      my $mode='xml';
        my $crs='/'.$ENV{'request.course.id'};      my $status='OPEN';
        if ($ENV{'request.course.sec'}) {      if ($Apache::lonhomework::parsing_a_problem) {
           $crs.='_'.$ENV{'request.course.sec'};   $mode='problem';
        }                    $status=$Apache::inputtags::status[-1]; 
        $crs=~s/\_/\//g;      }
        my $seeid=&Apache::lonnet::allowed('rin',$crs);      my $discussion=&Apache::lonfeedback::list_discussion($mode,$status);    
        my $symb=&Apache::lonnet::symbread();      if ($target eq 'tex') {
        if ($symb) {   $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
           my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},   &Apache::lonxml::newparser($parser,\$discussion,'');
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},   return '';
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});      } else {
           if ($contrib{'version'}) {   return $discussion.'</html>';
               $discussion.=  
                   '<address><hr /><h2>Course Discussion of Resource</h2>';  
               my $idx;  
               for ($idx=1;$idx<=$contrib{'version'};$idx++) {  
  my $hidden=($contrib{'hidden'}=~/\.$idx\./);  
  unless (($hidden) && (!$seeid)) {  
                  my $message=$contrib{$idx.':message'};  
                  $message=~s/\n/\<br \/\>/g;  
                  if ($message) {  
                   if ($hidden) {  
       $message='<font color="#888888">'.$message.'</font>';  
                   }  
                   my $sender='Anonymous';  
                   if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {  
                       $sender=$contrib{$idx.':sendername'}.' at '.  
       $contrib{$idx.':senderdomain'};  
                       if ($contrib{$idx.':anonymous'}) {  
   $sender.=' (anonymous)';  
                       }  
                       if ($seeid) {  
   if ($hidden) {  
                              $sender.=' <a href="/adm/feedback?unhide='.  
  $symb.':::'.$idx.'">Make Visible</a>';  
                           } else {  
                              $sender.=' <a href="/adm/feedback?hide='.  
  $symb.':::'.$idx.'">Hide</a>';  
   }  
                       }                     
                   }  
   $discussion.='<p><b>'.$sender.'</b> ('.  
                       localtime($contrib{$idx.':timestamp'}).  
                       '):<blockquote>'.$message.  
                       '</blockquote></p>';  
         }  
                }   
               }  
               $discussion.='</address>';  
           }  
        }  
     }      }
     return $discussion.'</html>';  
 }  }
   
 sub tokeninputfield {  sub tokeninputfield {
     my $defhost=$Apache::lonnet::perlvar{'lonHostID'};      my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
     $defhost=~tr/a-z/A-Z/;      $defhost=~tr/a-z/A-Z/;
     return (<<ENDINPUTFIELD)      return (<<ENDINPUTFIELD)
 <script>  <script type="text/javascript">
     function updatetoken() {      function updatetoken() {
  var comp=new Array;   var comp=new Array;
         var barcode=unescape(document.tokeninput.barcode.value);          var barcode=unescape(document.tokeninput.barcode.value);
Line 292  sub printtokenheader { Line 270  sub printtokenheader {
     if ($target eq 'web') {      if ($target eq 'web') {
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));          my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
  return    return 
  '<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.   '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.
                'Checked out for '.$plainname.                 &mt('Checked out for').' '.$plainname.
                '<br />User: '.$tuname.' at '.$tudom.                 '<br />'.&mt('User').': '.$tuname.' at '.$tudom.
        '<br />ID: '.$idhash{$tuname}.         '<br />'.&mt('ID').': '.$idhash{$tuname}.
        '<br />CourseID: '.$tcrsid.         '<br />'.&mt('CourseID').': '.$tcrsid.
        '<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.         '<br />'.&mt('Course').': '.$ENV{'course.'.$tcrsid.'.description'}.
                '<br />DocID: '.$token.                 '<br />'.&mt('DocID').': '.$token.
                '<br />Time: '.localtime().'<hr />';                 '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';
     } else {      } else {
         return $token;          return $token;
     }      }
Line 308  sub printtokenheader { Line 286  sub printtokenheader {
 sub fontsettings() {  sub fontsettings() {
     my $headerstring='';      my $headerstring='';
     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {       if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
          $headerstring.=   $headerstring.=
              '<meta Content-Type="text/html; charset=x-mac-roman">';      '<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;      return $headerstring;
 }  }
   
 sub registerurl {  
     my $forcereg=shift;  
     if ($ENV{'request.publicaccess'}) {  
  return   
          '<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';  
     }  
     if ($Apache::lonxml::registered && !$forcereg) { return ''; }  
     $Apache::lonxml::registered=1;  
     if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {  
         my $hwkadd='';  
         if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {  
     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {  
  $hwkadd.=(<<ENDSUBM);  
                      menu.switchbutton  
            (7,1,'subm.gif','view sub','missions',  
                 'gocmd("/adm/grades","submission")');  
 ENDSUBM  
             }  
     if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {  
  $hwkadd.=(<<ENDGRDS);  
                      menu.switchbutton  
            (7,2,'pgrd.gif','problem','grades',  
                 'gocmd("/adm/grades","viewgrades")');  
 ENDGRDS  
             }  
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {  
  $hwkadd.=(<<ENDPARM);  
                      menu.switchbutton  
            (7,3,'pparm.gif','problem','parms',  
                 'gocmd("/adm/parmset","set")');  
 ENDPARM  
             }  
  }  
  return (<<ENDREGTHIS);  
        
 <script language="JavaScript">  
 // BEGIN LON-CAPA Internal  
   
     function LONCAPAreg() {  
   menu=window.open("","LONCAPAmenu");  
           menu.clearTimeout(menu.menucltim);  
   menu.currentURL=window.location.pathname;  
           menu.currentStale=0;  
           menu.clearbut(3,1);  
           menu.switchbutton  
        (6,3,'catalog.gif','catalog','info','catalog_info()');  
           menu.switchbutton  
        (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)');  
           menu.switchbutton  
     (8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)');  
           menu.switchbutton  
      (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)');  
           menu.switchbutton  
        (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)');  
           menu.switchbutton  
      (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)');  
           menu.switchbutton  
                             (9,1,'sbkm.gif','set','bookmark','set_bookmark()');  
           menu.switchbutton  
                          (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()');  
           menu.switchbutton  
                                (9,3,'anot.gif','anno-','tations','annotate()');  
           $hwkadd  
     }  
   
     function LONCAPAstale() {  
   menu=window.open("","LONCAPAmenu");  
           menu.currentStale=1;  
           menu.switchbutton  
              (3,1,'reload.gif','return','location','go(currentURL)');  
           menu.clearbut(7,1);  
           menu.clearbut(7,2);  
           menu.clearbut(7,3);  
           menu.menucltim=menu.setTimeout(  
  'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+  
  'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)',  
   2000);  
   
       }  
   
 // END LON-CAPA Internal  
 </script>  
 ENDREGTHIS  
   
     } else {  
         return (<<ENDDONOTREGTHIS);  
   
 <script language="JavaScript">  
 // BEGIN LON-CAPA Internal  
   
     function LONCAPAreg() {  
   menu=window.open("","LONCAPAmenu");  
           menu.currentStale=1;  
           menu.clearbut(2,1);  
           menu.clearbut(2,3);  
           menu.clearbut(8,1);  
           menu.clearbut(8,2);  
           menu.clearbut(8,3);  
           if (menu.currentURL) {  
              menu.switchbutton  
               (3,1,'reload.gif','return','location','go(currentURL)');  
    } else {  
       menu.clearbut(3,1);  
           }  
     }  
   
     function LONCAPAstale() {  
     }  
   
 // END LON-CAPA Internal  
 </script>  
 ENDDONOTREGTHIS  
   
     }  
 }  
   
 sub loadevents() {  
     return 'LONCAPAreg();';  
 }  
   
 sub unloadevents() {  
     return 'LONCAPAstale();';  
 }  
   
 sub printalltags {  sub printalltags {
   my $temp;    my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach $temp (sort keys %Apache::lonxml::alltags) {
Line 447  sub printalltags { Line 304  sub printalltags {
 }  }
   
 sub xmlparse {  sub xmlparse {
  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;   my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
   
    &setup_globals($request,$target);
    &Apache::inputtags::initialize_inputtags();
    &Apache::outputtags::initialize_outputtags();
    &Apache::edit::initialize_edit();
    &Apache::londefdef::initialize_londefdef();
   
   #
   # do we have a course style file?
   #
   
  &setup_globals($target);   if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') {
  #&printalltags();       my $bodytext=
    $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
        if ($bodytext) {
    foreach my $file (split(',',$bodytext)) {
        my $location=&Apache::lonnet::filelocation('',$file);
        my $styletext=&Apache::lonnet::getfile($location);
        if ($styletext ne '-1') {
    %style_for_target = (%style_for_target,
         &Apache::style::styleparser($target,$styletext));
        }
    }
        }
    } elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) {
        my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'});
        my $styletext=&Apache::lonnet::getfile($location);
          if ($styletext ne '-1') {
             %style_for_target = (%style_for_target,
                             &Apache::style::styleparser($target,$styletext));
         }
    }
   #&printalltags();
  my @pars = ();   my @pars = ();
  my $pwd=$ENV{'request.filename'};   my $pwd=$ENV{'request.filename'};
  $pwd =~ s:/[^/]*$::;   $pwd =~ s:/[^/]*$::;
Line 463  sub xmlparse { Line 350  sub xmlparse {
   
  ($target, my @tenta) = split('&&',$target);   ($target, my @tenta) = split('&&',$target);
   
  my @stack = ();    my @stack = ();
  my @parstack = ();   my @parstack = ();
  &initdepth;   &initdepth;
   
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target);     $safeeval,\%style_for_target);
   
  if ($ENV{'request.uri'}) {   if ($ENV{'request.uri'}) {
     &writeallows($ENV{'request.uri'});      &writeallows($ENV{'request.uri'});
  }   }
    &do_registered_ssi();
    if ($Apache::lonxml::counter_changed) { &store_counter() }
  return $finaloutput;   return $finaloutput;
 }  }
   
Line 485  sub htmlclean { Line 375  sub htmlclean {
   
     my $output= $tree->as_HTML(undef,' ');      my $output= $tree->as_HTML(undef,' ');
   
     $output=~s/\<(br|hr|img|meta|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;      $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis;
     $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;      $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
     unless ($full) {      unless ($full) {
        $output=~s/\<[\/]*(body|head|html)\>//gis;         $output=~s/\<[\/]*(body|head|html)\>//gis;
Line 496  sub htmlclean { Line 386  sub htmlclean {
     return $output;      return $output;
 }  }
   
   sub latex_special_symbols {
       my ($string,$where)=@_;
       if ($where eq 'header') {
    $string =~ s/(\\|_|\^)/ /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/\\/\\ensuremath{\\backslash}/g;
    $string=~s/([^\\]|^)\%/$1\\\%/g;
    $string=~s/([^\\]|^)\$/$1\\\$/g;
    $string=~s/([^\\])\_/$1\\_/g;
    $string=~s/\$\$/\$\\\$/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;
           $string=~s/\|/\$\\mid\$/g;
   #single { or } How to escape?
       }
       return $string;
   }
   
 sub inner_xmlparse {  sub inner_xmlparse {
   my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
   my $finaloutput = '';    my $finaloutput = '';
   my $result;    my $result;
   my $token;    my $token;
     my $dontpop=0;
   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') || ($token->[0] eq 'D') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
  if ($metamode<1) {   if ($metamode<1) {
   $result=$token->[1];      my $text=$token->[1];
       if ($token->[0] eq 'C' && $target eq 'tex') {
    $text = '';
   # $text = '%'.$text."\n";
       }
       $result.=$text;
    }
         } elsif (($token->[0] eq 'D')) {
    if ($metamode<1 && $target eq 'web') {
       my $text=$token->[1];
       $result.=$text;
  }   }
       } elsif ($token->[0] eq 'PI') {        } elsif ($token->[0] eq 'PI') {
  if ($metamode<1) {   if ($metamode<1 && $target eq 'web') {
   $result=$token->[2];    $result=$token->[2];
  }   }
       } elsif ($token->[0] eq 'S') {        } elsif ($token->[0] eq 'S') {
Line 517  sub inner_xmlparse { Line 448  sub inner_xmlparse {
  # add parameters list to another stack   # add parameters list to another stack
  push (@$parstack,&parstring($token));   push (@$parstack,&parstring($token));
  &increasedepth($token);   &increasedepth($token);
  if (exists $$style_for_target{$token->[1]}) {   if ($Apache::lonxml::usestyle &&
   if ($Apache::lonxml::redirection) {      exists($$style_for_target{$token->[1]})) {
     $Apache::lonxml::outputstack['-1'] .=      $Apache::lonxml::usestyle=0;
       &recurse($$style_for_target{$token->[1]},$target,$safeeval,      my $string=$$style_for_target{$token->[1]}.
        $style_for_target,@$parstack);        '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
   } else {      &Apache::lonxml::newparser($pars,\$string);
     $finaloutput .= &recurse($$style_for_target{$token->[1]},$target,      $Apache::lonxml::style_values=$$parstack[-1];
      $safeeval,$style_for_target,@$parstack);      $Apache::lonxml::style_end_values=$$parstack[-1];
   }  
  } else {   } else {
   $result = &callsub("start_$token->[1]", $target, $token, $stack,    $result = &callsub("start_$token->[1]", $target, $token, $stack,
      $parstack, $pars, $safeeval, $style_for_target);       $parstack, $pars, $safeeval, $style_for_target);
  }   }
       } elsif ($token->[0] eq 'E') {        } elsif ($token->[0] eq 'E') {
  #clear out any tags that didn't end   if ($Apache::lonxml::usestyle &&
  while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {      exists($$style_for_target{'/'."$token->[1]"})) {
   &Apache::lonxml::warning('Missing tag &lt;/'.$$stack['-1'].'&gt; in file');      $Apache::lonxml::usestyle=0;
   &end_tag($stack,$parstack,$token);      my $string=$$style_for_target{'/'.$token->[1]}.
  }        '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
       &Apache::lonxml::newparser($pars,\$string);
  if (exists($$style_for_target{'/'."$token->[1]"})) {      $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
   if ($Apache::lonxml::redirection) {      $Apache::lonxml::style_end_values='';
     $Apache::lonxml::outputstack['-1'] .=        $dontpop=1;
       &recurse($$style_for_target{'/'."$token->[1]"},  
        $target,$safeeval,$style_for_target,@$parstack);  
   } else {  
     $finaloutput .= &recurse($$style_for_target{'/'."$token->[1]"},  
      $target,$safeeval,$style_for_target,  
      @$parstack);  
   }  
  } else {   } else {
   $result = &callsub("end_$token->[1]", $target, $token, $stack,      #clear out any tags that didn't end
      $parstack, $pars,$safeeval, $style_for_target);      while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
    my $lasttag=$$stack[-1];
    if ($token->[1] =~ /^\Q$lasttag\E$/i) {
       &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' as end tag to &lt;'.$$stack[-1].'&gt;');
       last;
    } else {
       &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' when looking for &lt;/'.$$stack[-1].'&gt; in file');
       &end_tag($stack,$parstack,$token);
    }
       }
       $result = &callsub("end_$token->[1]", $target, $token, $stack,
          $parstack, $pars,$safeeval, $style_for_target);
  }   }
       } else {        } else {
  &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");   &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
       }        }
       #evaluate variable refs in result        #evaluate variable refs in result
       if ($result ne "") {        if ($Apache::lonxml::post_evaluate &&$result ne "") {
  if ( $#$parstack > -1 ) {    my $extras;
   if ($Apache::lonxml::redirection) {    if (!$Apache::lonxml::usestyle) {
     $Apache::lonxml::outputstack['-1'] .=         $extras=$Apache::lonxml::style_values;
       &Apache::run::evaluate($result,$safeeval,$$parstack['-1']);  
   } else {  
     $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
    $$parstack['-1']);  
   }    }
    if ( $#$parstack > -1 ) {
     $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
  } else {   } else {
   $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');    $result= &Apache::run::evaluate($result,$safeeval,$extras);
  }   }
  $result = '';        }
       }         $Apache::lonxml::post_evaluate=1;
       if ($token->[0] eq 'E') {   
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
     #Style file definitions should be correct
     if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
         $result=&latex_special_symbols($result);
     }
         }
   
         if ($Apache::lonxml::redirection) {
    $Apache::lonxml::outputstack['-1'] .= $result;
         } else {
    $finaloutput.=$result;
         }
         $result = '';
   
         if ($token->[0] eq 'E' && !$dontpop) {
  &end_tag($stack,$parstack,$token);   &end_tag($stack,$parstack,$token);
       }        }
         $dontpop=0;
       }
       if ($#$pars > -1) {
    pop @$pars;
    pop @Apache::lonxml::pwd;
     }      }
     pop @$pars;  
     pop @Apache::lonxml::pwd;  
   }    }
   
   # if ($target eq 'meta') {    # if ($target eq 'meta') {
   #   $finaloutput.=&endredirection;    #   $finaloutput.=&endredirection;
   # }    # }
   
   
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }    }    
   return $finaloutput;    return $finaloutput;
 }  }
   
 sub recurse {  ## 
   my @innerstack = ();   ## Looks to see if there is a subroutine defined for this tag.  If so, call it,
   my @innerparstack = ();  ## otherwise do not call it as we do not know what it is.
   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;  ##
   my @pat = ();  
   &newparser(\@pat,\$newarg);  
   my $tokenpat;  
   my $partstring = '';  
   my $output='';  
   my $decls='';  
   &Apache::lonxml::debug("Recursing");  
   while ( $#pat > -1 ) {  
     while  ($tokenpat = $pat[$#pat]->get_token) {  
       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {  
  if ($metamode<1) { $partstring=$tokenpat->[1]; }  
       } elsif ($tokenpat->[0] eq 'PI') {  
  if ($metamode<1) { $partstring=$tokenpat->[2]; }  
       } elsif ($tokenpat->[0] eq 'S') {  
  push (@innerstack,$tokenpat->[1]);  
  push (@innerparstack,&parstring($tokenpat));  
  &increasedepth($tokenpat);  
  $partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat,  
        \@innerstack, \@innerparstack, \@pat,  
        $safeeval, $style_for_target);  
       } elsif ($tokenpat->[0] eq 'E') {  
  #clear out any tags that didn't end  
  while ($tokenpat->[1] ne $innerstack[$#innerstack]   
        && ($#innerstack > -1)) {  
   &Apache::lonxml::warning('Missing tag &lt;/'.$innerstack['-1'].'&gt; in style');  
   &end_tag(\@innerstack,\@innerparstack,$tokenpat);  
  }  
  $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,  
        \@innerstack, \@innerparstack, \@pat,  
        $safeeval, $style_for_target);  
       } else {  
  &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");  
       }  
       #pass both the variable to the style tag, and the tag we   
       #are processing inside the <definedtag>  
       if ( $partstring ne "" ) {  
  if ( $#parstack > -1 ) {   
   if ( $#innerparstack > -1 ) {   
     $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];  
   } else {  
     $decls= $parstack[$#parstack];  
   }  
  } else {  
   if ( $#innerparstack > -1 ) {   
     $decls=$innerparstack[$#innerparstack];  
   } else {  
     $decls='';  
   }  
  }  
  $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);  
  $partstring = '';  
       }  
       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;  
  &decreasedepth($tokenpat);}  
     }  
     pop @pat;  
     pop @Apache::lonxml::pwd;  
   }  
   &Apache::lonxml::debug("Exiting Recursing");  
   return $output;  
 }  
   
 sub callsub {  sub callsub {
   my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;    my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $currentstring='';    my $currentstring='';
Line 661  sub callsub { Line 550  sub callsub {
     my $sub1;      my $sub1;
     no strict 'refs';      no strict 'refs';
     my $tag=$token->[1];      my $tag=$token->[1];
   # get utterly rid of extended html tags
       if ($tag=~/^x\-/i) { return ''; }
     my $space=$Apache::lonxml::alltags{$tag}[-1];      my $space=$Apache::lonxml::alltags{$tag}[-1];
     if (!$space) {      if (!$space) {
       $tag=~tr/A-Z/a-z/;        $tag=~tr/A-Z/a-z/;
Line 677  sub callsub { Line 568  sub callsub {
     }      }
     if (!$deleted) {      if (!$deleted) {
       if ($space) {        if ($space) {
  #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");   #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
  $sub1="$space\:\:$sub";   $sub1="$space\:\:$sub";
  ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,   ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
      $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
      $style);       $style);
       } else {        } else {
  #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");            if ($target eq 'tex') {
                 # throw away tag name
                 return '';
             }
    #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
  if ($metamode <1) {   if ($metamode <1) {
   if (defined($token->[4]) && ($metamode < 1)) {    if (defined($token->[4]) && ($metamode < 1)) {
     $currentstring = $token->[4];      $currentstring = $token->[4];
Line 695  sub callsub { Line 590  sub callsub {
       #    &Apache::lonxml::debug("nodefalt:$nodefault:");        #    &Apache::lonxml::debug("nodefalt:$nodefault:");
       if ($currentstring eq '' && $nodefault eq '') {        if ($currentstring eq '' && $nodefault eq '') {
  if ($target eq 'edit') {   if ($target eq 'edit') {
   &Apache::lonxml::debug("doing default edit for $token->[1]");    #&Apache::lonxml::debug("doing default edit for $token->[1]");
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring = &Apache::edit::tag_start($target,$token);      $currentstring = &Apache::edit::tag_start($target,$token);
   } elsif ($token->[0] eq 'E') {    } elsif ($token->[0] eq 'E') {
Line 705  sub callsub { Line 600  sub callsub {
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring = $token->[4];      $currentstring = $token->[4];
     $currentstring.=&Apache::edit::handle_insert();      $currentstring.=&Apache::edit::handle_insert();
     } elsif ($token->[0] eq 'E') {
       $currentstring = $token->[2];
               $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
   } else {    } else {
     $currentstring = $token->[2];      $currentstring = $token->[2];
   }    }
Line 717  sub callsub { Line 615  sub callsub {
 }  }
   
 sub setup_globals {  sub setup_globals {
   my ($target)=@_;    my ($request,$target)=@_;
     $Apache::lonxml::request=$request;
   $Apache::lonxml::registered = 0;    $Apache::lonxml::registered = 0;
     @Apache::lonxml::htmlareafields=();
     $errorcount=0;
     $warningcount=0;
     $Apache::lonxml::default_homework_loaded=0;
     $Apache::lonxml::usestyle=1;
     &init_counter();
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @Apache::lonxml::ssi_info=();
     $Apache::lonxml::post_evaluate=1;
     $Apache::lonxml::warnings_error_header='';
   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 746  sub setup_globals { Line 654  sub setup_globals {
     $Apache::lonxml::metamode = 0;      $Apache::lonxml::metamode = 0;
     $Apache::lonxml::evaluate = 0;      $Apache::lonxml::evaluate = 0;
     $Apache::lonxml::import = 0;      $Apache::lonxml::import = 0;
     } elsif ($target eq 'analyze') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
   } else {    } else {
     $Apache::lonxml::redirection = 0;      $Apache::lonxml::redirection = 0;
     $Apache::lonxml::metamode = 0;      $Apache::lonxml::metamode = 0;
Line 759  sub init_safespace { Line 672  sub init_safespace {
   $safeeval->permit("entereval");    $safeeval->permit("entereval");
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
     $safeeval->permit("time");
   $safeeval->deny(":base_io");    $safeeval->deny(":base_io");
   $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');    $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
     $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');
   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');    $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
       $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
     '&chem_standard_order');
   
   $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');    $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
   $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');    $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
   $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');    $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
Line 782  sub init_safespace { Line 699  sub init_safespace {
   $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');    $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
   $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');    $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
   $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');    $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
     
     $safehole->wrap(\&Math::Cephes::bdtr  ,$safeeval,'&bdtr'  );
     $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' );
     $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' );
     $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' );
     $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' );
     $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc');
     $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri');
     $safehole->wrap(\&Math::Cephes::fdtr  ,$safeeval,'&fdtr'  );
     $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' );
     $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' );
     $safehole->wrap(\&Math::Cephes::gdtr  ,$safeeval,'&gdtr'  );
     $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' );
     $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' );
     $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc');
     $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri');
     $safehole->wrap(\&Math::Cephes::ndtr  ,$safeeval,'&ndtr'  );
     $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' );
     $safehole->wrap(\&Math::Cephes::pdtr  ,$safeeval,'&pdtr'  );
     $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' );
     $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' );
     $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
     $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');
   
   #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
   #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
   #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
   #  $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul');
   #  $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv');
   #  $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid');
   
   $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');    $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
   $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');    $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');
   $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');    $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');
Line 803  sub init_safespace { Line 751  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');
     $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
   
 #need to inspect this class of ops  #need to inspect this class of ops
 # $safeeval->deny(":base_orig");  # $safeeval->deny(":base_orig");
     $safeeval->permit("require");
   $safeinit .= ';$external::target="'.$target.'";';    $safeinit .= ';$external::target="'.$target.'";';
   my $rndseed;    my $rndseed;
   my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();    my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
   $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);    $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
   $safeinit .= ';$external::randomseed='.$rndseed.';';    $safeinit .= ';$external::randomseed="'.$rndseed.'";';
     &Apache::lonxml::debug("Setting rndseed to $rndseed");
   &Apache::run::run($safeinit,$safeeval);    &Apache::run::run($safeinit,$safeeval);
   
   }
   
   sub default_homework_load {
       my ($safeeval)=@_;
       &Apache::lonxml::debug('Loading default_homework');
       my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
       if ($default eq -1) {
    &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
       } else {
    &Apache::run::run($default,$safeeval);
    $Apache::lonxml::default_homework_loaded=1;
       }
 }  }
   
   my $metamode_was;
 sub startredirection {  sub startredirection {
   $Apache::lonxml::redirection++;      if (!$Apache::lonxml::redirection) {
   push (@Apache::lonxml::outputstack, '');   $metamode_was=$Apache::lonxml::metamode;
       }
       $Apache::lonxml::metamode=0;
       $Apache::lonxml::redirection++;
       push (@Apache::lonxml::outputstack, '');
 }  }
   
 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 debuging information:".join ":",caller);
     return '';   return '';
   }      }
   $Apache::lonxml::redirection--;      $Apache::lonxml::redirection--;
   pop @Apache::lonxml::outputstack;      if (!$Apache::lonxml::redirection) {
    $Apache::lonxml::metamode=$metamode_was;
       }
       pop @Apache::lonxml::outputstack;
 }  }
   
 sub end_tag {  sub end_tag {
Line 841  sub initdepth { Line 815  sub initdepth {
   $Apache::lonxml::olddepth=-1;    $Apache::lonxml::olddepth=-1;
 }  }
   
   my @timers;
   my $lasttime;
 sub increasedepth {  sub increasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth++;    $Apache::lonxml::depth++;
Line 848  sub increasedepth { Line 824  sub increasedepth {
   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {    if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth;      $Apache::lonxml::olddepth=$Apache::lonxml::depth;
   }    }
     push(@timers,[&gettimeofday()]);
     my $time=&tv_interval($lasttime);
     $lasttime=[&gettimeofday()];
     my $spacing='  'x($Apache::lonxml::depth-1);
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");    &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n");
 #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";  #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
 }  }
   
Line 861  sub decreasedepth { Line 841  sub decreasedepth {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;      $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
   }    }
   if (  $Apache::lonxml::depth < -1) {    if (  $Apache::lonxml::depth < -1) {
     &Apache::lonxml::warning("Missing tags, unable to properly run file.");      &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     $Apache::lonxml::depth='-1';      $Apache::lonxml::depth='-1';
   }    }
     my $timer=pop(@timers);
     my $time=&tv_interval($lasttime);
     $lasttime=[&gettimeofday()];
     my $spacing='  'x$Apache::lonxml::depth;
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");    &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");
 #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_all_text {  sub get_all_text_unbalanced {
   #there is a copy of this in lonpublisher.pm
       my($tag,$pars)= @_;
       my $token;
       my $result='';
       $tag='<'.$tag.'>';
       while ($token = $$pars[-1]->get_token) {
    if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
       $result.=$token->[1];
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {
       $result.=$token->[4];
    } elsif ($token->[0] eq 'E')  {
       $result.=$token->[2];
    }
    if ($result =~ /\Q$tag\E/is) {
       ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
       #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
       #&Apache::lonxml::debug('Result is :'.$1);
       $redo=$tag.$redo;
       &Apache::lonxml::newparser($pars,\$redo);
       last;
    }
       }
       return $result
   }
   
  my($tag,$pars)= @_;  sub increment_counter {
  my $depth=0;      my ($increment) = @_;
  my $token;      if (defined($increment) && $increment gt 0) {
  my $result='';   $Apache::lonxml::counter+=$increment;
  if ( $tag =~ m:^/: ) {       } else {
    my $tag=substr($tag,1);    $Apache::lonxml::counter++;
 #   &Apache::lonxml::debug("have:$tag:");      }
    while (($depth >=0) && ($token = $pars->get_token)) {      $Apache::lonxml::counter_changed=1;
 #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");  }
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {  
        $result.=$token->[1];  sub init_counter {
      } elsif ($token->[0] eq 'PI') {      if (defined($ENV{'form.counter'})) {
        $result.=$token->[2];   $Apache::lonxml::counter=$ENV{'form.counter'};
      } elsif ($token->[0] eq 'S') {   $Apache::lonxml::counter_changed=0;
        if ($token->[1] eq $tag) { $depth++; }      } else {
        $result.=$token->[4];   $Apache::lonxml::counter=1;
      } elsif ($token->[0] eq 'E')  {   $Apache::lonxml::counter_changed=1;
        if ( $token->[1] eq $tag) { $depth--; }      }
        #skip sending back the last end tag  }
        if ($depth > -1) { $result.=$token->[2]; } else {  
  $pars->unget_token($token);  sub store_counter {
        }      &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
      }      return '';
    }  }
  } else {  
    while ($token = $pars->get_token) {  sub get_all_text {
 #     &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");      my($tag,$pars,$style)= @_;
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {      my $gotfullstack=1;
        $result.=$token->[1];      if (ref($pars) ne 'ARRAY') {
      } elsif ($token->[0] eq 'PI') {   $gotfullstack=0;
        $result.=$token->[2];   $pars=[$pars];
      } elsif ($token->[0] eq 'S') {      }
        if ( $token->[1] eq $tag) {       if (ref($style) ne 'HASH') {
  $pars->unget_token($token); last;   $style={};
        } else {      }
  $result.=$token->[4];      my $depth=0;
        }      my $token;
      } elsif ($token->[0] eq 'E')  {      my $result='';
        $result.=$token->[2];      if ( $tag =~ m:^/: ) { 
      }   my $tag=substr($tag,1); 
    }   #&Apache::lonxml::debug("have:$tag:");
  }   my $top_empty=0;
 # &Apache::lonxml::debug("Exit:$result:");   while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
  return $result      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
    #&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')) {
       $result.=$token->[1];
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {
       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] =~ /^\Q$tag\E$/i) { $depth--; }
       #skip sending back the last end tag
       if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
    my $string=
       '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
    $$style{'/'.$token->[1]}.
       $token->[2].
    '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
    &Apache::lonxml::newparser($pars,\$string);
    #&Apache::lonxml::debug("reParsing $string");
    next;
       }
       if ($depth > -1) {
    $result.=$token->[2];
       } else {
    $$pars[-1]->unget_token($token);
       }
    }
       }
       if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
       if (($depth >=0) && ($#$pars > 0) ) {
    pop(@$pars);
    pop(@Apache::lonxml::pwd);
       }
    }
    if ($top_empty && $depth >= 0) {
       #never found the end tag ran out of text, throw error send back blank
       &error('Never found end tag for &lt;'.$tag.
      '&gt; current string <pre>'.
      &HTML::Entities::encode($result,'<>&"').
      '</pre>');
       if ($gotfullstack) {
    my $newstring='</'.$tag.'>'.$result;
    &Apache::lonxml::newparser($pars,\$newstring);
       }
       $result='';
    }
       } else {
    while ($#$pars > -1) {
       while ($token = $$pars[-1]->get_token) {
    #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
    if (($token->[0] eq 'T')||($token->[0] eq 'C')||
       ($token->[0] eq 'D')) {
       $result.=$token->[1];
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {
       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$/) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
    } elsif ($token->[0] eq 'E')  {
       $result.=$token->[2];
    }
       }
       if (($#$pars > 0) ) {
    pop(@$pars);
    pop(@Apache::lonxml::pwd);
       } else { last; }
    }
       }
       #&Apache::lonxml::debug("Exit:$result:");
       return $result
 }  }
   
 sub newparser {  sub newparser {
   my ($parser,$contentref,$dir) = @_;    my ($parser,$contentref,$dir) = @_;
   push (@$parser,HTML::TokeParser->new($contentref));    push (@$parser,HTML::LCParser->new($contentref));
   $$parser['-1']->xml_mode('1');    $$parser['-1']->xml_mode('1');
   if ( $dir eq '' ) {    if ( $dir eq '' ) {
     push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);      push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
   } else {    } else {
     push (@Apache::lonxml::pwd, $dir);      push (@Apache::lonxml::pwd, $dir);
   }     } 
 #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");  
 #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");  
 }  }
   
 sub parstring {  sub parstring {
Line 936  sub parstring { Line 1021  sub parstring {
   foreach (@{$token->[3]}) {    foreach (@{$token->[3]}) {
     unless ($_=~/\W/) {      unless ($_=~/\W/) {
       my $val=$token->[2]->{$_};        my $val=$token->[2]->{$_};
       $val =~ s/([\%\@\\])/\\$1/g;        $val =~ s/([\%\@\\\"\'])/\\$1/g;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }        #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";"        $temp .= "my \$$_=\"$val\";";
     }      }
   }    }
   return $temp;    return $temp;
Line 961  sub writeallows { Line 1046  sub writeallows {
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
 }  }
   
   sub register_ssi {
       my ($url,%form)=@_;
       push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form});
       return '';
   }
   
   sub do_registered_ssi {
       foreach my $info (@Apache::lonxml::ssi_info) {
    my %form=%{ $info->{'form'}};
    my $url=$info->{'url'};
    &Apache::lonnet::ssi($url,%form);
       }
   }
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
 sub afterburn {  sub afterburn {
     my $result=shift;      my $result=shift;
     foreach (split(/&/,$ENV{'QUERY_STRING'})) {      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        my ($name, $value) = split(/=/,$_);      ['highlight','anchor','link']);
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     }  
     if ($ENV{'form.highlight'}) {      if ($ENV{'form.highlight'}) {
        foreach (split(/\,/,$ENV{'form.highlight'})) {         foreach (split(/\,/,$ENV{'form.highlight'})) {
            my $anchorname=$_;             my $anchorname=$_;
    my $matchthis=$anchorname;     my $matchthis=$anchorname;
            $matchthis=~s/\_+/\\s\+/g;             $matchthis=~s/\_+/\\s\+/g;
            $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;             $result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs;
        }         }
     }      }
     if ($ENV{'form.link'}) {      if ($ENV{'form.link'}) {
Line 989  sub afterburn { Line 1079  sub afterburn {
            my ($anchorname,$linkurl)=split(/\>/,$_);             my ($anchorname,$linkurl)=split(/\>/,$_);
    my $matchthis=$anchorname;     my $matchthis=$anchorname;
            $matchthis=~s/\_+/\\s\+/g;             $matchthis=~s/\_+/\\s\+/g;
            $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;             $result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
        }         }
     }      }
     if ($ENV{'form.anchor'}) {      if ($ENV{'form.anchor'}) {
         my $anchorname=$ENV{'form.anchor'};          my $anchorname=$ENV{'form.anchor'};
  my $matchthis=$anchorname;   my $matchthis=$anchorname;
         $matchthis=~s/\_+/\\s\+/g;          $matchthis=~s/\_+/\\s\+/g;
         $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;          $result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
         $result.=(<<"ENDSCRIPT");          $result.=(<<"ENDSCRIPT");
 <script>  <script type="text/javascript">
     document.location.hash='$anchorname';      document.location.hash='$anchorname';
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
Line 1008  ENDSCRIPT Line 1098  ENDSCRIPT
   
 sub storefile {  sub storefile {
     my ($file,$contents)=@_;      my ($file,$contents)=@_;
       &Apache::lonnet::correct_line_ends(\$contents);
     if (my $fh=Apache::File->new('>'.$file)) {      if (my $fh=Apache::File->new('>'.$file)) {
  print $fh $contents;   print $fh $contents;
         $fh->close();          $fh->close();
           return 1;
     } else {      } else {
       &warning("Unable to save file $file");   &warning("Unable to save file $file");
    return 0;
     }      }
 }  }
   
 sub inserteditinfo {  sub createnewhtml {
       my ($result,$filecontents)=@_;      my $title=&mt('Title of document goes here');
       unless ($filecontents) {      my $body=&mt('Body of document goes here');
   $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 of Document Goes Here  
 </title>  
 </head>  </head>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
   $body
                            Body of Document Goes Here  
   
 </body>  </body>
 </html>  </html>
 SIMPLECONTENT  SIMPLECONTENT
       }      return $filecontents;
   }
   
   sub createnewsty {
     my $filecontents=(<<SIMPLECONTENT);
   <definetag name="">
       <render>
          <web></web>
          <tex></tex>
       </render>
   </definetag>
   SIMPLECONTENT
     return $filecontents;
   }
   
       $filecontents =~ s:</textarea>:&lt;/textarea&gt;:ig;  
   sub inserteditinfo {
         my ($result,$filecontents,$filetype)=@_;
         $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 $initialize='';
         if ($filetype eq 'html') {
     my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
     $initialize=&Apache::lonhtmlcommon::htmlareaheaders().
         &Apache::lonhtmlcommon::spellheader().(<<FULLPAGE);
   <script type="text/javascript">
   $addbuttons
   
       HTMLArea.loadPlugin("FullPage");
   
       function initDocument() {
    var editor=new HTMLArea("filecont",config);
    editor.registerPlugin(FullPage);
    editor.generate();
       }
   </script>
   FULLPAGE
             $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;
     $xml_help=&Apache::loncommon::helpLatexCheatsheet();
         }
         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 %lt=&Apache::lonlocal::texthash('st' => 'Save this',
    'vi' => 'View',
    'ed' => 'Edit');
         my $buttons=(<<BUTTONS);
   $cleanbut
   <input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />
   <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
   BUTTONS
         $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
         $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
   $initialize
 <hr />  <hr />
 <a name="editsection" />  <a name="editsection" />
 <form method="post">  <form method="post" name="xmledit">
 <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>  $xml_help
   <input type="hidden" name="editmode" value="$lt{'ed'}" />
   $buttons<br />
   <textarea cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
   <br />$buttons
 <br />  <br />
 <input type="hidden" name="showmode" value="Edit" />  
 <input type="submit" name="attemptclean"   
        value="Save and then attempt to clean HTML" />  
 <input type="submit" name="savethisfile" value="Save this" />  
 <input type="submit" name="showmode" value="View" />  
 </form>  </form>
   $titledisplay
   </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;  #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
       $result=~s/(\<\/body\>)/$editfooter/is;        $result=~s/(\<\/body\>)/$editfooter/is;
       return $result;        return $result;
 }  }
   
 sub editbutton {  sub get_target {
   my ($result) = @_;    my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
   my $button=(<<EDITBUTTON);    if ( $ENV{'request.state'} eq 'published') {
 <form method="post">      if ( defined($ENV{'form.grade_target'})
 <input type="submit" name="showmode" value="Edit" />   && ($viewgrades == 'F' )) {
 </form>        return ($ENV{'form.grade_target'});
 EDITBUTTON      } elsif (defined($ENV{'form.grade_target'})) {
   $result=~s/(\<\/body\>)/$button/is;        if (($ENV{'form.grade_target'} eq 'web') ||
   return $result;    ($ENV{'form.grade_target'} eq 'tex') ) {
 }   return $ENV{'form.grade_target'}
         } else {
 sub handler {   return 'web';
   my $request=shift;        }
       } else {
   my $target='web';        return 'web';
       }
   $Apache::lonxml::debug=0;    } elsif ($ENV{'request.state'} eq 'construct') {
       if ( defined($ENV{'form.grade_target'})) {
   if ($ENV{'browser.mathml'}) {        return ($ENV{'form.grade_target'});
     $request->content_type('text/xml');      } else {
         return 'web';
       }
   } else {    } else {
     $request->content_type('text/html');      return 'web';
   }    }
   &Apache::loncommon::no_cache($request);  }
   $request->send_http_header;  
   
   return OK if $request->header_only;  sub handler {
       my $request=shift;
       
       my $target=&get_target();
       
       $Apache::lonxml::debug=$ENV{'user.debug'};
       
       if ($ENV{'browser.mathml'}) {
    &Apache::loncommon::content_type($request,'text/xml');
       } else {
    &Apache::loncommon::content_type($request,'text/html');
       }
       &Apache::loncommon::no_cache($request);
       $request->send_http_header;
       
       return OK if $request->header_only;
   
   
   my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
       my $filetype;
       if ($file =~ /\.sty$/) {
    $filetype='sty';
       } else {
    $filetype='html';
       }
 #  #
 # 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'}) || ($ENV{'form.attemptclean'})) {
   &storefile($file,$ENV{'form.filecont'});      if (&storefile($file,$ENV{'form.filecont'})) {
       }   &Apache::lonxml::info("<font COLOR=\"#0000FF\">".
   }        &mt('Updated').": ".
   my %mystyle;        &Apache::lonlocal::locallocaltime(time).
   my $result = '';        " </font>");
   my $filecontents=&Apache::lonnet::getfile($file);      } 
   if ($filecontents == -1) {   }
     $result=(<<ENDNOTFOUND);      }
       my %mystyle;
       my $result = '';
       my $filecontents=&Apache::lonnet::getfile($file);
       if ($filecontents eq -1) {
    my $bodytag=&Apache::loncommon::bodytag('File Error');
    my $fnf=&mt('File not found');
    $result=(<<ENDNOTFOUND);
 <html>  <html>
 <head>  <head>
 <title>File not found</title>  <title>$fnf</title>
 </head>  </head>
 <body bgcolor="#FFFFFF">  $bodytag
 <b>File not found: $file</b>  <b>$fnf: $file</b>
 </body>  </body>
 </html>  </html>
 ENDNOTFOUND  ENDNOTFOUND
     $filecontents='';      $filecontents='';
   } else {   if ($ENV{'request.state'} ne 'published') {
     unless ($ENV{'request.state'} eq 'published') {      if ($filetype eq 'sty') {
       if ($ENV{'form.attemptclean'}) {   $filecontents=&createnewsty();
  $filecontents=&htmlclean($filecontents,1);      } else {
       }   $filecontents=&createnewhtml();
     }      }
     if ($ENV{'form.showmode'} ne 'Edit') {      $ENV{'form.editmode'}='Edit'; #force edit mode
       $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);   }
       } else {
    unless ($ENV{'request.state'} eq 'published') {
       if ($ENV{'form.attemptclean'}) {
    $filecontents=&htmlclean($filecontents,1);
       }
   #
   # we are in construction space, see if edit mode forced
               &Apache::loncommon::get_unprocessed_cgi
                             ($ENV{'QUERY_STRING'},['editmode']);
    }
    if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
    '',%mystyle);
    }
     }      }
   }      
   
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
   unless ($ENV{'request.state'} eq 'published') {      unless ($ENV{'request.state'} eq 'published') {
     if ($ENV{'form.showmode'} eq 'Edit') {   if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
       $result='<html><body bgcolor="#FFFFFF"></body></html>';      my $displayfile=$request->uri;
       $result=&inserteditinfo($result,$filecontents);      $displayfile=~s/^\/[^\/]*//;
     } else {      $result='<html><body bgcolor="#FFFFFF">'.
       $result = &editbutton($result);   &Apache::lonxml::message_location().'<h3>'.
    $displayfile.
    '</h3></body></html>';
       $result=&inserteditinfo($result,$filecontents,$filetype);
    }
     }      }
   }      if ($filetype eq 'html') { writeallows($request->uri); }
   
   writeallows($request->uri);      
       &Apache::lonxml::add_messages(\$result);
   $request->print($result);      $request->print($result);
       
   return OK;      return OK;
   }
   
   sub display_title {
       my $result;
       if ($ENV{'request.state'} eq 'construct') {
    my $title=&Apache::lonnet::gettitle();
    if (!defined($title) || $title eq '') {
       $title = $ENV{'request.filename'};
       $title = substr($title, rindex($title, '/') + 1);
    }
    $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>";
       }
       return $result;
 }  }
   
 sub debug {  sub debug {
   if ($Apache::lonxml::debug eq 1) {      if ($Apache::lonxml::debug eq "1") {
     $|=1;   $|=1;
     print("DEBUG:".join('<br />',@_)."<br />\n");   my $request=$Apache::lonxml::request;
   }   if (!$request) { $request=Apache->request; }
    $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
   # &Apache::lonnet::logthis($_[0]);
       }
 }  }
   
 sub error {  sub error {
   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {      $errorcount++;
     print "<b>ERROR:</b>".join('<br />',@_)."<br />\n";      if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
   } else {   # If printing in construction space, put the error inside <pre></pre>
     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";   push(@Apache::lonxml::error_messages,
     #notify author       $Apache::lonxml::warnings_error_header.
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));       "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");
     #notify course   $Apache::lonxml::warnings_error_header='';
     if ( $ENV{'request.course.id'} ) {      } else {
       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};   my $errormsg;
       my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});   my ($symb)=&Apache::lonnet::symbread();
       foreach my $user (split /\,/, $users) {   if ( !$symb ) {
  ($user,my $domain) = split /:/, $user;      #public or browsers
  &Apache::lonmsg::user_normal_msg($user,$domain,      $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
         "Error [$declutter]",join('<br />',@_));   } 
       }   #notify author
    &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
    #notify course
    if ( $symb && $ENV{'request.course.id'} ) {
       my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
       my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
       my @userlist;
       foreach (keys %users) {
    my ($user,$domain) = split(/:/, $_);
    push(@userlist,"$user\@$domain");
    &Apache::lonmsg::user_normal_msg($user,$domain,
    "Error [$declutter]",join('<br />',@_));
       }
       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));
       } else {
    $errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
       }
    }
    push(@Apache::lonxml::error_messages,"<b>$errormsg</b> <br />");
     }      }
   
     #FIXME probably shouldn't have me get everything forever.  
     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));  
     #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);  
   }  
 }  }
   
 sub warning {  sub warning {
   if ($ENV{'request.state'} eq 'construct') {      $warningcount++;
     print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\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.
    "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\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('<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) = @_;      my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
   if ( ! $context ) { $context = -1; }      if ( ! $context ) { $context = -1; }
   my $args ='';      my $args ='';
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }      if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
   if ( $args =~ /my \$$param=\"/ ) {      if ( ! $Apache::lonxml::usestyle ) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'   $args=$Apache::lonxml::style_values.$args;
   } else {      }
     return undef;      if ( ! $args ) { return undef; }
   }      if ( $case_insensitive ) {
    if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
       return &Apache::run::run("{$args;".'return $'.$param.'}',
                                        $safeeval); #'
    } else {
       return undef;
    }
       } else {
    if ( $args =~ /my \$\Q$param\E=\"/ ) {
       return &Apache::run::run("{$args;".'return $'.$param.'}',
                                        $safeeval); #'
    } else {
       return undef;
    }
       }
 }  }
   
 sub get_param_var {  sub get_param_var {
   my ($param,$parstack,$safeeval,$context) = @_;    my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
   if ( ! $context ) { $context = -1; }    if ( ! $context ) { $context = -1; }
   my $args ='';    my $args ='';
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }    if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
   if ( $args !~ /my \$$param=\"/ ) { return undef; }    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)) {
     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); #'
   if ($value =~ /^[\$\@\%]/) {    &Apache::lonxml::debug("first run is $value");
     return &Apache::run::run("return $value",$safeeval,1);    if ($value =~ /^[\$\@\%]\w+$/) {
         &Apache::lonxml::debug("doing second");
         my @result=&Apache::run::run("return $value",$safeeval,1);
         if (!defined($result[0])) {
     return $value
         } else {
     if (wantarray) { return @result; } else { return $result[0]; }
         }
   } else {    } else {
     return $value;      return $value;
   }    }
Line 1210  sub register_insert { Line 1493  sub register_insert {
     my $line = $data[$i];      my $line = $data[$i];
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }      if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
     if ( $line =~ /TABLE/ ) { last; }      if ( $line =~ /TABLE/ ) { last; }
     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);      my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
     if ($tag) {      if ($tag) {
       $insertlist{"$tagnum.tag"} = $tag;        $insertlist{"$tagnum.tag"} = $tag;
       $insertlist{"$tagnum.description"} = $descrip;        $insertlist{"$tagnum.description"} = $descrip;
Line 1218  sub register_insert { Line 1501  sub register_insert {
       $insertlist{"$tagnum.function"} = $function;        $insertlist{"$tagnum.function"} = $function;
       if (!defined($show)) { $show='yes'; }        if (!defined($show)) { $show='yes'; }
       $insertlist{"$tagnum.show"}= $show;        $insertlist{"$tagnum.show"}= $show;
         $insertlist{"$tagnum.helpfile"} = $helpfile;
         $insertlist{"$tagnum.helpdesc"} = $helpdesc;
       $insertlist{"$tag.num"}=$tagnum;        $insertlist{"$tag.num"}=$tagnum;
       $tagnum++;        $tagnum++;
     }      }
Line 1252  sub description { Line 1537  sub description {
   return $insertlist{$tagnum.'.description'};    return $insertlist{$tagnum.'.description'};
 }  }
   
   # Returns a list containing the help file, and the description
   sub helpinfo {
     my ($token)=@_;
     my $tagnum;
     my $tag=$token->[1];
     foreach my $namespace (reverse @Apache::lonxml::namespace) {
       my $testtag=$namespace.'::'.$tag;
       $tagnum=$insertlist{"$testtag.num"};
       if (defined($tagnum)) { last; }
     }
     if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
     return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
   }
   
 # ----------------------------------------------------------------- whichuser  # ----------------------------------------------------------------- whichuser
 # returns a list of $symb, $courseid, $domain, $name that is correct for  # returns a list of $symb, $courseid, $domain, $name that is correct for
 # calls to lonnet functions for this setup.  # calls to lonnet functions for this setup.
 # - looks for form.grade_ parameters  # - looks for form.grade_ parameters
 sub whichuser {  sub whichuser {
   my ($symb,$courseid,$domain,$name);    my ($passedsymb)=@_;
     my ($symb,$courseid,$domain,$name,$publicuser);
   if (defined($ENV{'form.grade_symb'})) {    if (defined($ENV{'form.grade_symb'})) {
     my $tmp_courseid=$ENV{'form.grade_courseid'};      my $tmp_courseid=$ENV{'form.grade_courseid'};
     my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);      my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
     if ($allowed) {      if ($allowed) {
       $symb=$ENV{'form.grade_symb'};        $symb=$ENV{'form.grade_symb'};
       $courseid=$ENV{'form.grade_courseid'};        $courseid=$ENV{'form.grade_courseid'};
Line 1268  sub whichuser { Line 1568  sub whichuser {
       $name=$ENV{'form.grade_username'};        $name=$ENV{'form.grade_username'};
     }      }
   } else {    } else {
     $symb=&Apache::lonnet::symbread();        if (!$passedsymb) {
     $courseid=$ENV{'request.course.id'};            $symb=&Apache::lonnet::symbread();
     $domain=$ENV{'user.domain'};        } else {
     $name=$ENV{'user.name'};            $symb=$passedsymb;
         }
         $courseid=$ENV{'request.course.id'};
         $domain=$ENV{'user.domain'};
         $name=$ENV{'user.name'};
         if ($name eq 'public' && $domain eq 'public') {
     if (!defined($ENV{'form.username'})) {
         $ENV{'form.username'}.=time.rand(10000000);
     }
     $name.=$ENV{'form.username'};
         }
   }    }
   return ($symb,$courseid,$domain,$name);    return ($symb,$courseid,$domain,$name,$publicuser);
 }  }
   
 1;  1;
Removed from v.1.148  
changed lines
  Added in v.1.339

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.