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

Diff for /loncom/xml/lonxml.pm between versions 1.92 and 1.301

version 1.92, 2001/06/12 22:39:36 version 1.301, 2004/02/06 20:59:50
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # XML Parser Module   # XML Parser Module 
 #  #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   # Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 
   # TtHfunc and TtMfunc (the "Code") may be compiled and linked into 
   # binary executable programs or libraries distributed by the 
   # Michigan State University (the "Licensee"), but any binaries so 
   # distributed are hereby licensed only for use in the context
   # of a program or computational system for which the Licensee is the 
   # primary author or distributor, and which performs substantial 
   # additional tasks beyond the translation of (La)TeX into HTML.
   # The C source of the Code may not be distributed by the Licensee
   # to any other parties under any circumstances.
   #
 # last modified 06/26/00 by Alexander Sakharuk  # last modified 06/26/00 by Alexander Sakharuk
 # 11/6 Gerd Kortemeyer  # 11/6 Gerd Kortemeyer
 # 6/1/1 Gerd Kortemeyer  # 6/1/1 Gerd Kortemeyer
 # 2/21,3/13 Guy  # 2/21,3/13 Guy
 # 3/29,5/4 Gerd Kortemeyer  # 3/29,5/4 Gerd Kortemeyer
 # 5/10 Scott Harrison  
 # 5/26 Gerd Kortemeyer  # 5/26 Gerd Kortemeyer
 # 5/27 H. K. Ng  # 5/27 H. K. Ng
 # 6/2,6/3,6/8,6/9 Gerd Kortemeyer  # 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 $prevent_entity_encode $errorcount $warningcount);
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::LCParser();
 use Safe;  use HTML::TreeBuilder();
 use Safe::Hole;  use HTML::Entities();
 use Math::Cephes qw(:trigs :hypers :bessels erf erfc);  use Safe();
 use Math::Random qw(:all);  use Safe::Hole();
 use Opcode;  use Math::Cephes();
   use Math::Random();
   use Opcode();
   use POSIX qw(strftime);
   
   
 sub register {  sub register {
   my $space;    my ($space,@taglist) = @_;
   my @taglist;    foreach my $temptag (@taglist) {
   my $temptag;      push(@{ $Apache::lonxml::alltags{$temptag} },$space);
   ($space,@taglist) = @_;    }
   foreach $temptag (@taglist) {  }
     $Apache::lonxml::alltags{$temptag}=$space;  
   sub deregister {
     my ($space,@taglist) = @_;
     foreach my $temptag (@taglist) {
       my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
       if ($tempspace eq $space) {
         pop(@{ $Apache::lonxml::alltags{$temptag} });
       }
   }    }
     #&printalltags();
 }  }
   
 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::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 68  $evaluate = 1; Line 138  $evaluate = 1;
 # data structure for eidt mode, determines what tags can go into what other tags  # data structure for eidt mode, determines what tags can go into what other tags
 %insertlist=();  %insertlist=();
   
 #stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
   # if 0 all high ASCII characters will be encoded into HTML Entities
   $prevent_entity_encode=0;
   
   # has the dynamic menu been updated to know about this resource
   $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='';
   if ($ENV{'browser.mathml'}) {    if ($ENV{'browser.mathml'}) {
Line 87  sub xmlbegin { Line 186  sub xmlbegin {
 }  }
   
 sub xmlend {  sub xmlend {
     return '</html>';      my $mode='xml';
 }      my $status='OPEN';
       if ($Apache::lonhomework::parsing_a_problem) {
 sub fontsettings() {   $mode='problem';
     my $headerstring='';   $status=$Apache::inputtags::status[-1]; 
     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {   
          $headerstring.=  
              '<meta Content-Type="text/html; charset=x-mac-roman">';  
     }      }
     return $headerstring;      return &Apache::lonfeedback::list_discussion($mode,$status).'</html>';
 }  }
   
 sub registerurl {  sub tokeninputfield {
     if ($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) {      my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
         my $hwkadd='';      $defhost=~tr/a-z/A-Z/;
         if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {      return (<<ENDINPUTFIELD)
     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {  <script type="text/javascript">
  $hwkadd.=(<<ENDSUBM);      function updatetoken() {
                      menu.switchbutton   var comp=new Array;
            (7,1,'subm.gif','view sub','missions',          var barcode=unescape(document.tokeninput.barcode.value);
                 'gocmd("/adm/grades","submission")');          comp=barcode.split('*');
 ENDSUBM          if (typeof(comp[0])!="undefined") {
             }      document.tokeninput.codeone.value=comp[0];
     if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {   }
  $hwkadd.=(<<ENDGRDS);          if (typeof(comp[1])!="undefined") {
                      menu.switchbutton      document.tokeninput.codetwo.value=comp[1];
            (7,2,'pgrd.gif','problem','grades',   }
                 'gocmd("/adm/grades","viewgrades")');          if (typeof(comp[2])!="undefined") {
 ENDGRDS              comp[2]=comp[2].toUpperCase();
             }      document.tokeninput.codethree.value=comp[2];
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {   }
  $hwkadd.=(<<ENDPARM);          document.tokeninput.barcode.value='';
                      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  
        (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)');  
           $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);',  
   2000);  
   
       }  
   
 // END LON-CAPA Internal  
 </script>  </script>
 ENDREGTHIS  <form method="post" name="tokeninput">
   <table border="2" bgcolor="#FFFFBB">
     } else {  <tr><th>DocID Checkin</th></tr>
         return (<<ENDDONOTREGTHIS);  <tr><td>
   <table>
 <script language="JavaScript">  <tr>
 // BEGIN LON-CAPA Internal  <td>Scan in Barcode</td>
   <td><input type="text" size="22" name="barcode" 
   onChange="updatetoken()"/></td>
   </tr>
   <tr><td><i>or</i> Type in DocID</td>
   <td>
   <input type="text" size="5" name="codeone" />
   <b><font size="+2">*</font></b>
   <input type="text" size="5" name="codetwo" />
   <b><font size="+2">*</font></b>
   <input type="text" size="10" name="codethree" value="$defhost" 
   onChange="this.value=this.value.toUpperCase()" />
   </td></tr>
   </table>
   </td></tr>
   <tr><td><input type="submit" value="Check in DocID" /></td></tr>
   </table>
   </form>
   ENDINPUTFIELD
   }
   
     function LONCAPAreg() {  sub maketoken {
   menu=window.open("","LONCAPAmenu");      my ($symb,$tuname,$tudom,$tcrsid)=@_;
           menu.currentStale=1;      unless ($symb) {
           menu.clearbut(2,1);   $symb=&Apache::lonnet::symbread();
           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);  
           }  
     }      }
       unless ($tuname) {
     function LONCAPAstale() {   $tuname=$ENV{'user.name'};
           $tudom=$ENV{'user.domain'};
           $tcrsid=$ENV{'request.course.id'};
     }      }
   
 // END LON-CAPA Internal      return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
 </script>  }
 ENDDONOTREGTHIS  
   
   sub printtokenheader {
       my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
       unless ($token) { return ''; }
   
       my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
       unless ($tsymb) {
    $tsymb=$symb;
       }
       unless ($tuname) {
    $tuname=$name;
           $tudom=$domain;
           $tcrsid=$courseid;
     }      }
 }  
   
 sub loadevents() {      my %reply=&Apache::lonnet::get('environment',
     return 'LONCAPAreg();';                ['firstname','middlename','lastname','generation'],
                 $tudom,$tuname);
       my $plainname=$reply{'firstname'}.' '. 
                     $reply{'middlename'}.' '.
                     $reply{'lastname'}.' '.
     $reply{'generation'};
   
       if ($target eq 'web') {
           my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
    return 
    '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.
                  &mt('Checked out for').' '.$plainname.
                  '<br />'.&mt('User').': '.$tuname.' at '.$tudom.
          '<br />'.&mt('ID').': '.$idhash{$tuname}.
          '<br />'.&mt('CourseID').': '.$tcrsid.
          '<br />'.&mt('Course').': '.$ENV{'course.'.$tcrsid.'.description'}.
                  '<br />'.&mt('DocID').': '.$token.
                  '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';
       } else {
           return $token;
       }
 }  }
   
 sub unloadevents() {  sub fontsettings() {
     return 'LONCAPAstale();';      my $headerstring='';
       if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
    $headerstring.=
       '<meta Content-Type="text/html; charset=x-mac-roman">';
       } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) {
    $headerstring.=
       '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
       }
       return $headerstring;
 }  }
   
 sub printalltags {  sub printalltags {
   my $temp;    my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach $temp (sort keys %Apache::lonxml::alltags) {
     &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");      &Apache::lonxml::debug("$temp -- ".
     join(',',@{ $Apache::lonxml::alltags{$temp} }));
   }    }
 }  }
   
 sub xmlparse {  sub xmlparse {
  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;   my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
  if ($target eq 'meta') {  
    $Apache::lonxml::redirection = 0;   &setup_globals($request,$target);
    $Apache::lonxml::metamode = 1;   &Apache::inputtags::initialize_inputtags();
    $Apache::lonxml::evaluate = 1;   &Apache::outputtags::initialize_outputtags();
    $Apache::lonxml::import = 0;   &Apache::edit::initialize_edit();
  } elsif ($target eq 'grade') {   &Apache::londefdef::initialize_londefdef();
    &startredirection;  
    $Apache::lonxml::metamode = 0;  #
    $Apache::lonxml::evaluate = 1;  # do we have a course style file?
    $Apache::lonxml::import = 1;  #
  } elsif ($target eq 'modified') {  
    $Apache::lonxml::redirection = 0;   if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') {
    $Apache::lonxml::metamode = 0;       my $bodytext=
    $Apache::lonxml::evaluate = 0;   $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
    $Apache::lonxml::import = 0;       if ($bodytext) {
  } else {         my $location=&Apache::lonnet::filelocation('',$bodytext);
    $Apache::lonxml::redirection = 0;         my $styletext=&Apache::lonnet::getfile($location);
    $Apache::lonxml::metamode = 0;         if ($styletext ne '-1') {
    $Apache::lonxml::evaluate = 1;            %style_for_target = (%style_for_target,
    $Apache::lonxml::import = 1;                            &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();  #&printalltags();
  my @pars = ();   my @pars = ();
  @Apache::lonxml::pwd=();  
  my $pwd=$ENV{'request.filename'};   my $pwd=$ENV{'request.filename'};
  $pwd =~ s:/[^/]*$::;   $pwd =~ s:/[^/]*$::;
  &newparser(\@pars,\$content_file_string,$pwd);   &newparser(\@pars,\$content_file_string,$pwd);
  my $currentstring = '';  
  my $finaloutput = '';   
  my $newarg = '';  
  my $result;  
   
  my $safeeval = new Safe;   my $safeeval = new Safe;
  my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
Line 255  sub xmlparse { Line 361  sub xmlparse {
   
  ($target, my @tenta) = split('&&',$target);   ($target, my @tenta) = split('&&',$target);
   
  my @stack = ();    my @stack = ();
  my @parstack = ();   my @parstack = ();
  &initdepth;   &initdepth;
  my $token;  
  while ( $#pars > -1 ) {   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    while ($token = $pars[$#pars]->get_token) {     $safeeval,\%style_for_target);
      if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {  
        if ($metamode<1) { $result=$token->[1]; }   if ($ENV{'request.uri'}) {
      } elsif ($token->[0] eq 'PI') {      &writeallows($ENV{'request.uri'});
        if ($metamode<1) { $result=$token->[2]; }  
      } elsif ($token->[0] eq 'S') {  
        # add tag to stack      
        push (@stack,$token->[1]);  
        # add parameters list to another stack  
        push (@parstack,&parstring($token));  
        &increasedepth($token);         
        if (exists $style_for_target{$token->[1]}) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-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 {  
  $result = &callsub("start_$token->[1]", $target, $token, \@stack,  
     \@parstack, \@pars, $safeeval, \%style_for_target);  
        }                
      } elsif ($token->[0] eq 'E')  {  
        #clear out any tags that didn't end  
        while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {  
  &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");  
  pop @stack;pop @parstack;&decreasedepth($token);  
        }  
          
        if (exists $style_for_target{'/'."$token->[1]"}) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-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 {  
  $result = &callsub("end_$token->[1]", $target, $token, \@stack,   
     \@parstack, \@pars,$safeeval, \%style_for_target);  
        }  
      } else {  
        &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");  
      }  
      #evaluate variable refs in result  
      if ($result ne "") {  
        if ( $#parstack > -1 ) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-1'] .=   
      &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);  
  } else {  
    $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
   $parstack[$#parstack]);  
  }  
        } else {  
  $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');  
        }  
        $result = '';  
      }   
      if ($token->[0] eq 'E') {   
        pop @stack;pop @parstack;&decreasedepth($token);  
      }  
    }  
    pop @pars;  
    pop @Apache::lonxml::pwd;  
  }   }
    &do_registered_ssi();
    if ($Apache::lonxml::counter_changed) { &store_counter() }
    return $finaloutput;
   }
   
 # if ($target eq 'meta') {  sub htmlclean {
 #   $finaloutput.=&endredirection;      my ($raw,$full)=@_;
 # }  
   
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {      my $tree = HTML::TreeBuilder->new;
       $finaloutput=&afterburn($finaloutput);      $tree->ignore_unknown(0);
   }  
   
  return $finaloutput;      $tree->parse($raw);
   
       my $output= $tree->as_HTML(undef,' ');
   
       $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis;
       $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
       unless ($full) {
          $output=~s/\<[\/]*(body|head|html)\>//gis;
       }
   
       $tree = $tree->delete;
   
       return $output;
 }  }
   
   sub latex_special_symbols {
       my ($string,$where)=@_;
       if ($where eq 'header') {
    $string =~ s/(\\|_|\^)/ /g;
    $string =~ s/(\$|%|\#|&|\{|\})/\\$1/g;
    $string =~ s/_/ /g;
       } else {
    $string=~s/\\ /\\char92 /g;
    $string=~s/\^/\\\^\\strut /g;
    $string=~s/\~/\\char126 /g;
    #fixup & if it doesn't look like
           # &#123; or &alpha;
    $string=~s/(&(?!((\#[0-9]+)|([a-z]+));))/\\$1/gi;
    $string=~s/([^&])\#/$1\\#/g;
    $string=~s/([^\\])\#/$1\\#/g;
    $string=~s/(\$|_|{|})/\\$1/g;
    $string=~s/\\char92 /\\texttt{\\char92}/g;
    $string=~s/(>|<)/\$$1\$/g; #more or less
    if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit
    if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space
    if ($string eq '%.') {$string = '\%.';} #percent at the end of statement
       }
       return $string;
   }
   
 sub recurse {  sub inner_xmlparse {
       my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
   my @innerstack = ();     my $finaloutput = '';
   my @innerparstack = ();    my $result;
   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;    my $token;
   my @pat = ();    my $dontpop=0;
   &newparser(\@pat,\$newarg);    while ( $#$pars > -1 ) {
   my $tokenpat;      while ($token = $$pars['-1']->get_token) {
   my $partstring = '';        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
   my $output='';   if ($metamode<1) {
   my $decls='';      my $text=$token->[1];
   while ( $#pat > -1 ) {      if ($token->[0] eq 'C' && $target eq 'tex') {
     while  ($tokenpat = $pat[$#pat]->get_token) {   $text = '';
       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {  # $text = '%'.$text."\n";
  if ($metamode<1) { $partstring=$tokenpat->[1]; }      }
       } elsif ($tokenpat->[0] eq 'PI') {      $result.=$text;
  if ($metamode<1) { $partstring=$tokenpat->[2]; }   }
       } elsif ($tokenpat->[0] eq 'S') {        } elsif (($token->[0] eq 'D')) {
  push (@innerstack,$tokenpat->[1]);   if ($metamode<1 && $target eq 'web') {
  push (@innerparstack,&parstring($tokenpat));      my $text=$token->[1];
  &increasedepth($tokenpat);      $result.=$text;
  $partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat,   }
        \@innerstack, \@innerparstack, \@pat,        } elsif ($token->[0] eq 'PI') {
        $safeeval, $style_for_target);   if ($metamode<1 && $target eq 'web') {
       } elsif ($tokenpat->[0] eq 'E') {    $result=$token->[2];
  #clear out any tags that didn't end   }
  while ($tokenpat->[1] ne $innerstack[$#innerstack]         } elsif ($token->[0] eq 'S') {
        && ($#innerstack > -1)) {   # add tag to stack
   &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");   push (@$stack,$token->[1]);
   pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);   # add parameters list to another stack
  }   push (@$parstack,&parstring($token));
  $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,   &increasedepth($token);
        \@innerstack, \@innerparstack, \@pat,   if ($Apache::lonxml::usestyle &&
        $safeeval, $style_for_target);      exists($$style_for_target{$token->[1]})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
       &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$$parstack[-1];
       $Apache::lonxml::style_end_values=$$parstack[-1];
    } else {
     $result = &callsub("start_$token->[1]", $target, $token, $stack,
        $parstack, $pars, $safeeval, $style_for_target);
    }
         } elsif ($token->[0] eq 'E') {
    if ($Apache::lonxml::usestyle &&
       exists($$style_for_target{'/'."$token->[1]"})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{'/'.$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
       &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
       $Apache::lonxml::style_end_values='';
       $dontpop=1;
    } else {
       #clear out any tags that didn't end
       while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
    my $lasttag=$$stack[-1];
    if ($token->[1] =~ /^$lasttag$/i) {
       &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 :$tokenpat->[0]:$tokenpat->[1]:");   &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
       }        }
       #pass both the variable to the style tag, and the tag we         #evaluate variable refs in result
       #are processing inside the <definedtag>        if ($Apache::lonxml::post_evaluate &&$result ne "") {
       if ( $partstring ne "" ) {    my $extras;
  if ( $#parstack > -1 ) {     if (!$Apache::lonxml::usestyle) {
   if ( $#innerparstack > -1 ) {         $extras=$Apache::lonxml::style_values;
     $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];  
   } else {  
     $decls= $parstack[$#parstack];  
   }    }
    if ( $#$parstack > -1 ) {
     $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
  } else {   } else {
   if ( $#innerparstack > -1 ) {     $result= &Apache::run::evaluate($result,$safeeval,$extras);
     $decls=$innerparstack[$#innerparstack];  
   } else {  
     $decls='';  
   }  
  }   }
  $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);  
  $partstring = '';  
       }        }
       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;        $Apache::lonxml::post_evaluate=1;
  &decreasedepth($tokenpat);}  
         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);
     }
         }
   
         # Encode any high ASCII characters
   #      if (!$Apache::lonxml::prevent_entity_encode) {
   # $result=&HTML::Entities::encode($result,"\200-\377");
   #      }
         if ($Apache::lonxml::redirection) {
    $Apache::lonxml::outputstack['-1'] .= $result;
         } else {
    $finaloutput.=$result;
         }
         $result = '';
   
         if ($token->[0] eq 'E' && !$dontpop) {
    &end_tag($stack,$parstack,$token);
         }
         $dontpop=0;
       }
       if ($#$pars > -1) {
    pop @$pars;
    pop @Apache::lonxml::pwd;
     }      }
     pop @pat;  
     pop @Apache::lonxml::pwd;  
   }    }
   return $output;  
     # if ($target eq 'meta') {
     #   $finaloutput.=&endredirection;
     # }
   
   
     if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
       $finaloutput=&afterburn($finaloutput);
     }    
     return $finaloutput;
 }  }
   
 sub callsub {  sub callsub {
Line 417  sub callsub { Line 556  sub callsub {
     my $sub1;      my $sub1;
     no strict 'refs';      no strict 'refs';
     my $tag=$token->[1];      my $tag=$token->[1];
     my $space=$Apache::lonxml::alltags{$tag};  # get utterly rid of extended html tags
       if ($tag=~/^x\-/i) { return ''; }
       my $space=$Apache::lonxml::alltags{$tag}[-1];
     if (!$space) {      if (!$space) {
  $tag=~tr/A-Z/a-z/;        $tag=~tr/A-Z/a-z/;
  $sub=~tr/A-Z/a-z/;   $sub=~tr/A-Z/a-z/;
  $space=$Apache::lonxml::alltags{$tag}   $space=$Apache::lonxml::alltags{$tag}[-1]
     }      }
     if ($space) {  
       #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");      my $deleted=0;
       $sub1="$space\:\:$sub";      $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);      if (($token->[0] eq 'S') && ($target eq 'modified')) {
       ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,        $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
    $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
    $style);       $style);
     } else {      }
       #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");      if (!$deleted) {
       if ($metamode <1) {        if ($space) {
  if (defined($token->[4]) && ($metamode < 1)) {   #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
   $currentstring = $token->[4];   $sub1="$space\:\:$sub";
  } else {   ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
   $currentstring = $token->[2];       $parstack,$parser,$safeeval,
        $style);
         } else {
    #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
    if ($metamode <1) {
     if (defined($token->[4]) && ($metamode < 1)) {
       $currentstring = $token->[4];
     } else {
       $currentstring = $token->[2];
     }
  }   }
       }        }
     }        #    &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') {      $currentstring = &Apache::edit::tag_end($target,$token);
   $currentstring = &Apache::edit::tag_end($target,$token);    }
  }   } elsif ($target eq 'modified') {
       } elsif ($target eq 'modified') {    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') {
  } else {      $currentstring = $token->[2];
   $currentstring = $token->[2];              $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
     } else {
       $currentstring = $token->[2];
     }
  }   }
       }        }
     }      }
Line 463  sub callsub { Line 616  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   sub setup_globals {
     my ($request,$target)=@_;
     $Apache::lonxml::request=$request;
     $Apache::lonxml::registered = 0;
     $errorcount=0;
     $warningcount=0;
     $Apache::lonxml::default_homework_loaded=0;
     $Apache::lonxml::usestyle=1;
     &init_counter();
     @Apache::lonxml::pwd=();
     @Apache::lonxml::extlinks=();
     @Apache::lonxml::ssi_info=();
     $Apache::lonxml::post_evaluate=1;
     $Apache::lonxml::warnings_error_header='';
     if ($target eq 'meta') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'answer') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'grade') {
       &startredirection;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'modified') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 0;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'edit') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 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 {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     }
   }
   
 sub init_safespace {  sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;    my ($target,$safeeval,$safehole,$safeinit) = @_;
   $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::outputtags::multipart,$safeeval,'&multipart');
   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');    $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
       
   $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');    $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
Line 490  sub init_safespace { Line 698  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 501  sub init_safespace { Line 740  sub init_safespace {
   $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');    $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');
   $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');    $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');
   $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');    $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');
 #  $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');    $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');
   $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');    $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');
   $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');    $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');
   $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');    $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');
Line 515  sub init_safespace { Line 754  sub init_safespace {
 #need to inspect this class of ops  #need to inspect this class of ops
 # $safeeval->deny(":base_orig");  # $safeeval->deny(":base_orig");
   $safeinit .= ';$external::target="'.$target.'";';    $safeinit .= ';$external::target="'.$target.'";';
   $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';    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);
 }  }
   
   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;
       }
   }
   
 sub startredirection {  sub startredirection {
   $Apache::lonxml::redirection++;    $Apache::lonxml::redirection++;
   push (@Apache::lonxml::outputstack, '');    push (@Apache::lonxml::outputstack, '');
Line 533  sub endredirection { Line 788  sub endredirection {
   pop @Apache::lonxml::outputstack;    pop @Apache::lonxml::outputstack;
 }  }
   
   sub end_tag {
     my ($tagstack,$parstack,$token)=@_;
     pop(@$tagstack);
     pop(@$parstack);
     &decreasedepth($token);
   }
   
 sub initdepth {  sub initdepth {
   @Apache::lonxml::depthcounter=();    @Apache::lonxml::depthcounter=();
   $Apache::lonxml::depth=-1;    $Apache::lonxml::depth=-1;
Line 559  sub decreasedepth { Line 821  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("Unbalanced tags in resource");         &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     $Apache::lonxml::depth='-1';      $Apache::lonxml::depth='-1';
   }    }
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
Line 567  sub decreasedepth { Line 829  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_all_text {  sub get_all_text_unbalanced {
   #there is a copy of this in lonpublisher.pm
  my($tag,$pars)= @_;   my($tag,$pars)= @_;
  my $depth=0;  
  my $token;   my $token;
  my $result='';   my $result='';
  if ( $tag =~ m:^/: ) {    $tag='<'.$tag.'>';
    my $tag=substr($tag,1);    while ($token = $$pars[-1]->get_token) {
 #   &Apache::lonxml::debug("have:$tag:");     if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
    while (($depth >=0) && ($token = $pars->get_token)) {       $result.=$token->[1];
 #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");     } elsif ($token->[0] eq 'PI') {
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {       $result.=$token->[2];
        $result.=$token->[1];     } elsif ($token->[0] eq 'S') {
      } elsif ($token->[0] eq 'PI') {       $result.=$token->[4];
        $result.=$token->[2];     } elsif ($token->[0] eq 'E')  {
      } elsif ($token->[0] eq 'S') {       $result.=$token->[2];
        if ($token->[1] eq $tag) { $depth++; }  
        $result.=$token->[4];  
      } elsif ($token->[0] eq 'E')  {  
        if ( $token->[1] eq $tag) { $depth--; }  
        #skip sending back the last end tag  
        if ($depth > -1) { $result.=$token->[2]; } else {  
  $pars->unget_token($token);  
        }  
      }  
    }     }
  } else {     if ($result =~ /(.*)\Q$tag\E(.*)/s) {
    while ($token = $pars->get_token) {       &Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
 #     &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");       &Apache::lonxml::debug('Result is :'.$1);
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {       $result=$1;
        $result.=$token->[1];       my $redo=$tag.$2;
      } elsif ($token->[0] eq 'PI') {       &Apache::lonxml::newparser($pars,\$redo);
        $result.=$token->[2];       last;
      } elsif ($token->[0] eq 'S') {  
        if ( $token->[1] eq $tag) {   
  $pars->unget_token($token); last;  
        } else {  
  $result.=$token->[4];  
        }  
      } elsif ($token->[0] eq 'E')  {  
        $result.=$token->[2];  
      }  
    }     }
  }   }
 # &Apache::lonxml::debug("Exit:$result:");  
  return $result   return $result
 }  }
   
   sub increment_counter {
       my ($increment) = @_;
       if (defined($increment) && $increment gt 0) {
    $Apache::lonxml::counter+=$increment;
       } else {
    $Apache::lonxml::counter++;
       }
       $Apache::lonxml::counter_changed=1;
   }
   
   sub init_counter {
       if (defined($ENV{'form.counter'})) {
    $Apache::lonxml::counter=$ENV{'form.counter'};
    $Apache::lonxml::counter_changed=0;
       } else {
    $Apache::lonxml::counter=1;
    $Apache::lonxml::counter_changed=1;
       }
   }
   
   sub store_counter {
       &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
       return '';
   }
   
   sub get_all_text {
       my($tag,$pars,$style)= @_;
       my $gotfullstack=1;
       if (ref($pars) ne 'ARRAY') {
    $gotfullstack=0;
    $pars=[$pars];
       }
       if (ref($style) ne 'HASH') {
    $style={};
       }
       my $depth=0;
       my $token;
       my $result='';
       if ( $tag =~ m:^/: ) { 
    my $tag=substr($tag,1); 
    #&Apache::lonxml::debug("have:$tag:");
    my $top_empty=0;
    while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
       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] =~ /^$tag$/i) { $depth++; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
       $result.=$token->[4];
    } elsif ($token->[0] eq 'E')  {
       if ( $token->[1] =~ /^$tag$/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] =~ /^$tag$/i) {
    $$pars[-1]->unget_token($token); last;
       } else {
    $result.=$token->[4];
       }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
    } 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 {
   my ($token) = @_;    my ($token) = @_;
   my $temp='';    my $temp='';
   map {    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\";";
     }      }
   } @{$token->[3]};    }
   return $temp;    return $temp;
 }  }
   
 sub writeallows {  sub writeallows {
       unless ($#extlinks>=0) { return; }
     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);      my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
       if ($ENV{'httpref.'.$thisurl}) {
    $thisurl=$ENV{'httpref.'.$thisurl};
       }
     my $thisdir=$thisurl;      my $thisdir=$thisurl;
     $thisdir=~s/\/[^\/]+$//;      $thisdir=~s/\/[^\/]+$//;
     my %httpref=();      my %httpref=();
     map {      foreach (@extlinks) {
        $httpref{'httpref.'.         $httpref{'httpref.'.
          &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;           &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
       }
       @extlinks=();
     &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;
     map {      &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;  
    }  
        }  
     } (split(/&/,$ENV{'QUERY_STRING'}));  
     if ($ENV{'form.highlight'}) {      if ($ENV{'form.highlight'}) {
         map {         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/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
        } split(/\,/,$ENV{'form.highlight'});         }
     }      }
     if ($ENV{'form.link'}) {      if ($ENV{'form.link'}) {
         map {         foreach (split(/\,/,$ENV{'form.link'})) {
            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/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
        } split(/\,/,$ENV{'form.link'});         }
     }      }
     if ($ENV{'form.anchor'}) {      if ($ENV{'form.anchor'}) {
         my $anchorname=$ENV{'form.anchor'};          my $anchorname=$ENV{'form.anchor'};
Line 690  sub afterburn { Line 1064  sub afterburn {
         $matchthis=~s/\_+/\\s\+/g;          $matchthis=~s/\_+/\\s\+/g;
         $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;          $result=~s/($matchthis)/\<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 700  ENDSCRIPT Line 1074  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 {
    &warning("Unable to save file $file");
    return 0;
     }      }
 }  }
   
 sub inserteditinfo {  sub createnewhtml {
       my ($result,$filecontents)=@_;    my $filecontents=(<<SIMPLECONTENT);
       unless ($filecontents) {  
   $filecontents=(<<SIMPLECONTENT);  
 <html>  <html>
 <head>  <head>
 <title>  <title>
Line 723  sub inserteditinfo { Line 1100  sub inserteditinfo {
 </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;
   }
   
   
   sub inserteditinfo {
         my ($result,$filecontents,$filetype)=@_;
         $filecontents = &HTML::Entities::encode($filecontents);
   #      my $editheader='<a href="#editsection">Edit below</a><hr />';
         my $xml_help = '';
         if ($filetype eq 'html') {
     $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 $editheader='<a href="#editsection">Edit below</a><hr />';        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" value="$lt{'st'}" />
   <input type="submit" name="viewmode" value="$lt{'vi'}" />
   BUTTONS
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 <hr />  <hr />
 <a name="editsection" />  <a name="editsection" />
 <form method="post">  <form method="post">
   $xml_help
   <input type="hidden" name="editmode" value="$lt{'ed'}" />
   $buttons<br />
 <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>  <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
   <br />$buttons
 <br />  <br />
 <input type="submit" name="savethisfile" value="Save this file" />  
 </form>  </form>
   $titledisplay
 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 handler {  sub get_target {
   my $request=shift;    my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
     if ( $ENV{'request.state'} eq 'published') {
   my $target='web';      if ( defined($ENV{'form.grade_target'})
    && ($viewgrades == 'F' )) {
   $Apache::lonxml::debug=0;        return ($ENV{'form.grade_target'});
       } elsif (defined($ENV{'form.grade_target'})) {
   if ($ENV{'browser.mathml'}) {        if (($ENV{'form.grade_target'} eq 'web') ||
     $request->content_type('text/xml');    ($ENV{'form.grade_target'} eq 'tex') ) {
    return $ENV{'form.grade_target'}
         } else {
    return 'web';
         }
       } else {
         return 'web';
       }
     } elsif ($ENV{'request.state'} eq 'construct') {
       if ( defined($ENV{'form.grade_target'})) {
         return ($ENV{'form.grade_target'});
       } else {
         return 'web';
       }
   } else {    } else {
     $request->content_type('text/html');      return 'web';
   }    }
     }
   $request->send_http_header;  
     sub handler {
   return OK if $request->header_only;      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'}) {   if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {
   &storefile($file,$ENV{'form.filecont'});      if (&storefile($file,$ENV{'form.filecont'})) {
       }   $request->print("<font COLOR=\"#0000FF\">".&mt('Updated').": ".
   }  &Apache::lonlocal::locallocaltime(time)." </font>");
   my %mystyle;      } 
   my $result = '';    }
   my $filecontents=&Apache::lonnet::getfile($file);      }
   if ($filecontents == -1) {      my %mystyle;
     $result=(<<ENDNOTFOUND);      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') {
     $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);      if ($filetype eq 'sty') {
   }   $filecontents=&createnewsty();
       } else {
    $filecontents=&createnewhtml();
       }
       $ENV{'form.editmode'}='Edit'; #force edit mode
    }
       } 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') {
       $result=&inserteditinfo($result,$filecontents);   if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
   }      my $displayfile=$request->uri;
       $displayfile=~s/^\/[^\/]*//;
   $request->print($result);      $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.
    '</h3></body></html>';
   writeallows($request->uri);      $result=&inserteditinfo($result,$filecontents,$filetype);
   return OK;   }
       }
       if ($filetype eq 'html') { writeallows($request->uri); }
   
       
   
       $request->print($result);
       
       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") {
     print "DEBUG:".$_[0]."<br />\n";   $|=1;
   }   my $request=$Apache::lonxml::request;
    if (!$request) { $request=Apache->request; }
    $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0])."</pre></font>\n");
       }
 }  }
   
 sub error {  sub error {
     $errorcount++;
     my $request=$Apache::lonxml::request;
     if (!$request) { $request=Apache->request; }
   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {    if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
     print "<b>ERROR:</b>".$_[0]."<br />\n";      # If printing in construction space, put the error inside <pre></pre>
         $request->print($Apache::lonxml::warnings_error_header.
         "<b>ERROR:</b>".join("\n",@_)."\n");
         $Apache::lonxml::warnings_error_header='';
   } else {    } else {
     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";      $request->print("<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />");
     #notify author      #notify author
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);      &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
     #notify course      #notify course
     if ( $ENV{'request.course.id'} ) {      if ( $ENV{'request.course.id'} ) {
       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};        my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
       foreach my $user (split /\,/, $users) {        my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
  ($user,my $domain) = split /:/, $user;        foreach (keys %users) {
  &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);   my ($user,$domain) = split(/:/, $_);
    &Apache::lonmsg::user_normal_msg($user,$domain,
           "Error [$declutter]",join('<br />',@_));
       }        }
     }      }
   
     #FIXME probably shouldn't have me get everything forever.      #FIXME probably shouldn't have me get everything forever.
     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);      &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]);      #&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>".$_[0]."<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; }
       $request->print($Apache::lonxml::warnings_error_header.
         "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
       $Apache::lonxml::warnings_error_header='';
    }
       }
 }  }
   
 sub get_param {  sub get_param {
   my ($param,$parstack,$safeeval,$context) = @_;      my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
       if ( ! $context ) { $context = -1; }
       my $args ='';
       if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
       if ( ! $Apache::lonxml::usestyle ) {
    $args=$Apache::lonxml::style_values.$args;
       }
       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 {
     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]; }
   return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'    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); #'
     &Apache::lonxml::debug("first run is $value");
     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 {
       return $value;
     }
 }  }
   
 sub register_insert {  sub register_insert {
Line 849  sub register_insert { Line 1411  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);
     $insertlist{"$tagnum.tag"} = $tag;      if ($tag) {
     $insertlist{"$tagnum.description"} = $descrip;        $insertlist{"$tagnum.tag"} = $tag;
     $insertlist{"$tagnum.color"} = $color;        $insertlist{"$tagnum.description"} = $descrip;
     $insertlist{"$tagnum.function"} = $function;        $insertlist{"$tagnum.color"} = $color;
     $insertlist{"$tagnum.show"}= $show;        $insertlist{"$tagnum.function"} = $function;
     $insertlist{"$tag.num"}=$tagnum;        if (!defined($show)) { $show='yes'; }
     $tagnum++;        $insertlist{"$tagnum.show"}= $show;
         $insertlist{"$tagnum.helpfile"} = $helpfile;
         $insertlist{"$tagnum.helpdesc"} = $helpdesc;
         $insertlist{"$tag.num"}=$tagnum;
         $tagnum++;
       }
   }    }
   $i++; #skipping TABLE line    $i++; #skipping TABLE line
   $tagnum = 0;    $tagnum = 0;
Line 864  sub register_insert { Line 1431  sub register_insert {
     my $line = $data[$i];      my $line = $data[$i];
     my ($mnemonic,@which) = split(/ +/,$line);      my ($mnemonic,@which) = split(/ +/,$line);
     my $tag = $insertlist{"$tagnum.tag"};      my $tag = $insertlist{"$tagnum.tag"};
     for (my $j=0;$j <$#which;$j++) {      for (my $j=0;$j <=$#which;$j++) {
       if ( $which[$j] eq 'Y' ) {        if ( $which[$j] eq 'Y' ) {
  if ($insertlist{"$j.show"} ne 'no') {   if ($insertlist{"$j.show"} ne 'no') {
   push(@{ $insertlist{"$tag.which"} },$j);    push(@{ $insertlist{"$tag.which"} },$j);
Line 874  sub register_insert { Line 1441  sub register_insert {
     $tagnum++;      $tagnum++;
   }    }
 }  }
   
   sub description {
     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.'.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
   # returns a list of $symb, $courseid, $domain, $name that is correct for
   # calls to lonnet functions for this setup.
   # - looks for form.grade_ parameters
   sub whichuser {
     my ($passedsymb)=@_;
     my ($symb,$courseid,$domain,$name,$publicuser);
     if (defined($ENV{'form.grade_symb'})) {
       my $tmp_courseid=$ENV{'form.grade_courseid'};
       my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
       if ($allowed) {
         $symb=$ENV{'form.grade_symb'};
         $courseid=$ENV{'form.grade_courseid'};
         $domain=$ENV{'form.grade_domain'};
         $name=$ENV{'form.grade_username'};
       }
     } else {
         if (!$passedsymb) {
             $symb=&Apache::lonnet::symbread();
         } else {
             $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,$publicuser);
   }
   
 1;  1;
 __END__  __END__
   
Removed from v.1.92  
changed lines
  Added in v.1.301

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.