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

Diff for /loncom/xml/lonxml.pm between versions 1.175 and 1.568

version 1.175, 2002/05/29 16:22:09 version 1.568, 2024/01/25 23:37:14
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  =pod
 # 6/1/1 Gerd Kortemeyer  
 # 2/21,3/13 Guy  =head1 NAME
 # 3/29,5/4 Gerd Kortemeyer  
 # 5/10 Scott Harrison  Apache::lonxml
 # 5/26 Gerd Kortemeyer  
 # 5/27 H. K. Ng  =head1 SYNOPSIS
 # 6/2,6/3,6/8,6/9 Gerd Kortemeyer  
 # 6/12,6/13 H. K. Ng  XML Parsing Module
 # 6/16 Gerd Kortemeyer  
 # 7/27 H. K. Ng  This is part of the LearningOnline Network with CAPA project
 # 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer  described at http://www.lon-capa.org.
 # Guy Albertelli  
 # 9/26 Gerd Kortemeyer  
 # Dec Guy Albertelli  =head1 SUBROUTINES
 # YEAR=2002  
 # 1/1 Gerd Kortemeyer  =cut
 # 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 $prevent_entity_encode);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
 use strict;  use strict;
   use LONCAPA;
 use HTML::LCParser();  use HTML::LCParser();
 use HTML::TreeBuilder();  use HTML::TreeBuilder();
 use HTML::Entities();  use HTML::Entities();
Line 69  use Safe(); Line 69  use Safe();
 use Safe::Hole();  use Safe::Hole();
 use Math::Cephes();  use Math::Cephes();
 use Math::Random();  use Math::Random();
   use Math::Calculus::Expression();
   use Number::FormatEng();
 use Opcode();  use Opcode();
   use POSIX qw(strftime);
   use Time::HiRes qw( gettimeofday tv_interval );
   use Symbol();
   
 sub register {  sub register {
   my ($space,@taglist) = @_;    my ($space,@taglist) = @_;
Line 95  use Apache::style(); Line 100  use Apache::style();
 use Apache::run();  use Apache::run();
 use Apache::londefdef();  use Apache::londefdef();
 use Apache::scripttag();  use Apache::scripttag();
   use Apache::languagetags();
 use Apache::edit();  use Apache::edit();
 use Apache::lonnet();  use Apache::inputtags();
   use Apache::outputtags();
   use Apache::lonnet;
 use Apache::File();  use Apache::File();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonfeedback();
   use Apache::lonmsg();
   use Apache::loncacc();
   use Apache::lonmaxima();
   use Apache::lonr();
   use Apache::lonlocal;
   use Apache::lonhtmlcommon();
   use Apache::functionplotresponse();
   use Apache::lonnavmaps();
   
   #====================================   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 123  $metamode = 0; Line 146  $metamode = 0;
 # turns on and of run::evaluate actually derefencing var refs  # turns on and of run::evaluate actually derefencing var refs
 $evaluate = 1;  $evaluate = 1;
   
 # data structure for eidt mode, determines what tags can go into what other tags  # data structure for edit 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  # stores all Scrit Vars displays for later showing
 $prevent_entity_encode=0;  my @script_var_displays=();
   
 # has the dynamic menu been updated to know about this resource  
 $Apache::lonxml::registered=0;  
   
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
   
 sub xmlbegin {  # a problem number counter, and check on ether it is used
   my $output='';  $Apache::lonxml::counter=1;
   if ($ENV{'browser.mathml'}) {  $Apache::lonxml::counter_changed=0;
       $output='<?xml version="1.0"?>'  
             .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'  
             .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '  
             .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'  
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '   
  .'xmlns="http://www.w3.org/TR/REC-html40">';  
   } else {  
       $output='<html>';  
   }  
   return $output;  
 }  
   
 sub xmlend {  # Part counter hash.   In analysis mode, the
     my $discussion='';  # problems can use this to record which parts increment the counter
     if ($ENV{'request.course.id'}) {  # by how much.  The counter subs will maintain this hash via
        my $crs='/'.$ENV{'request.course.id'};  # their optional part parameters.  Note that the assumption is that
        if ($ENV{'request.course.sec'}) {  # analysis is done in one request and therefore it is not necessary to
           $crs.='_'.$ENV{'request.course.sec'};  # save this information request-to-request.
        }                   
        $crs=~s/\_/\//g;  
        my $seeid=&Apache::lonnet::allowed('rin',$crs);  
        my $symb=&Apache::lonnet::symbread();  
        if ($symb) {  
           my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},  
                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},  
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});  
           if ($contrib{'version'}) {  
               $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.':plainname'}.' ('.  
                               $contrib{$idx.':sendername'}.' at '.  
       $contrib{$idx.':senderdomain'}.')';  
                       if ($contrib{$idx.':anonymous'}) {  
   $sender.=' [anonymous] '.  
                                      $contrib{$idx.':screenname'};  
                       }  
                       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>';  
   }  
                       }                     
                   } else {  
                       if ($contrib{$idx.':screenname'}) {  
   $sender='<i>'.$contrib{$idx.':screenname'}.'</i>';  
                       }  
                   }  
   $discussion.='<p><b>'.$sender.'</b> ('.  
                       localtime($contrib{$idx.':timestamp'}).  
                       '):<blockquote>'.$message.  
                       '</blockquote></p>';  
         }  
                }   
               }  
               $discussion.='</address>';  
           }  
        }  
     }  
     return $discussion.'</html>';  
 }  
   
 sub tokeninputfield {  
     my $defhost=$Apache::lonnet::perlvar{'lonHostID'};  
     $defhost=~tr/a-z/A-Z/;  
     return (<<ENDINPUTFIELD)  
 <script>  
     function updatetoken() {  
  var comp=new Array;  
         var barcode=unescape(document.tokeninput.barcode.value);  
         comp=barcode.split('*');  
         if (typeof(comp[0])!="undefined") {  
     document.tokeninput.codeone.value=comp[0];  
  }  
         if (typeof(comp[1])!="undefined") {  
     document.tokeninput.codetwo.value=comp[1];  
  }  
         if (typeof(comp[2])!="undefined") {  
             comp[2]=comp[2].toUpperCase();  
     document.tokeninput.codethree.value=comp[2];  
  }  
         document.tokeninput.barcode.value='';  
     }    
 </script>  
 <form method="post" name="tokeninput">  
 <table border="2" bgcolor="#FFFFBB">  
 <tr><th>DocID Checkin</th></tr>  
 <tr><td>  
 <table>  
 <tr>  
 <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  
 }  
   
 sub maketoken {  %Apache::lonxml::counters_per_part = ();
     my ($symb,$tuname,$tudom,$tcrsid)=@_;  
     unless ($symb) {  
  $symb=&Apache::lonnet::symbread();  
     }  
     unless ($tuname) {  
  $tuname=$ENV{'user.name'};  
         $tudom=$ENV{'user.domain'};  
         $tcrsid=$ENV{'request.course.id'};  
     }  
   
     return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);  
 }  
   
 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;  
     }  
   
     my %reply=&Apache::lonnet::get('environment',  
               ['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.gif?encode='.$token.'" />'.  
                'Checked out for '.$plainname.  
                '<br />User: '.$tuname.' at '.$tudom.  
        '<br />ID: '.$idhash{$tuname}.  
        '<br />CourseID: '.$tcrsid.  
        '<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.  
                '<br />DocID: '.$token.  
                '<br />Time: '.localtime().'<hr />';  
     } else {  
         return $token;  
     }  
 }  
   
 sub fontsettings() {  #internal check on whether to look at style defs
     my $headerstring='';  $Apache::lonxml::usestyle=1;
     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {   
          $headerstring.=  
              '<meta Content-Type="text/html; charset=x-mac-roman">';  
     }  
     return $headerstring;  
 }  
   
 sub registerurl {  #locations used to store the parameter string for style substitutions
     my $forcereg=shift;  $Apache::lonxml::style_values='';
     my $target = shift;  $Apache::lonxml::style_end_values='';
     my $result = '';  
     if (($ENV{'request.publicaccess'}) ||   
        (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) {  
  return   
          '<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';  
     }  
     if ($Apache::lonxml::registered && !$forcereg) { return ''; }  
     $Apache::lonxml::registered=1;  
     my $nothing='';  
     if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }  
     my $timesync='menu.clock.setTime(1000*'.time.');';  
     if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {  
         my $hwkadd='';  
         if ($ENV{'request.filename'}=~/\.(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","gradingmenu")');  
 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  
             }  
  }  
  $result = (<<ENDREGTHIS);  
        
 <script language="JavaScript">  
 // BEGIN LON-CAPA Internal  
   
     function LONCAPAreg() {  
   menu=window.open("$nothing","LONCAPAmenu","",false);  
           menu.clearTimeout(menu.menucltim);  
           $timesync  
   menu.currentURL=window.location.pathname;  
           menu.reloadURL=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("$nothing","LONCAPAmenu","",false);  
           menu.currentStale=1;  
           if (menu.reloadURL!='' && menu.reloadURL!= null) {   
              menu.switchbutton  
              (3,1,'reload.gif','return','location','go(reloadURL)');  
   }  
           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);  
   
       }  #array of ssi calls that need to occur after we are done parsing
   @Apache::lonxml::ssi_info=();
   
 // END LON-CAPA Internal  #should we do the postag variable interpolation
 </script>  $Apache::lonxml::post_evaluate=1;
 ENDREGTHIS  
   
     } else {  #a header message to emit in the case of any generated warning or errors
         $result = (<<ENDDONOTREGTHIS);  $Apache::lonxml::warnings_error_header='';
   
 <script language="JavaScript">  #  Control whether or not LaTeX symbols should be substituted for their
 // BEGIN LON-CAPA Internal  #  \ style equivalents...this may be turned off e.g. in an verbatim
   #  environment.
   
     function LONCAPAreg() {  $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
   menu=window.open("$nothing","LONCAPAmenu","",false);  
           $timesync  
           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() {  sub enable_LaTeX_substitutions {
     }      $Apache::lonxml::substitute_LaTeX_symbols = 1;
   }
   sub disable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 0;
   }
   
 // END LON-CAPA Internal  sub xmlend {
 </script>      my ($target,$parser)=@_;
 ENDDONOTREGTHIS      my $mode='xml';
     }      my $status='OPEN';
     if ($target eq 'edit') {      if ($Apache::lonhomework::parsing_a_problem ||
  # Javascript routines for construction space:   $Apache::lonhomework::parsing_a_task ) {
  # openbrowser and opensearcher will start the file browser   $mode='problem';
  # (lonindexer) and searcher (lonsearchcat) respectively.   $status=$Apache::inputtags::status[-1]; 
  # Inputs are the name of the html form being used  
  # and the name of the element the selected URL should  
  # be placed in.  
         # openbrowser also takes arguments only and omit, which are  
         # comma deliminated lists of file extensions to (only) show   
         # or omit.  
         # Here we also set currentURL=null.  
         $result .=<<"ENDBROWSERSCRIPT";  
 <script>  
     menu.currentURL=null;  
     var editbrowser;  
     function openbrowser(formname,elementname,only,omit) {  
         var url = '/res/?';  
         if (editbrowser == null) {  
             url += 'launch=1&';  
         }  
         url += 'catalogmode=interactive&';  
         url += 'mode=edit&';  
         url += 'form=' + formname + '&';  
         if (only != null) {  
             url += 'only=' + only + '&';  
         }   
         if (omit != null) {  
             url += 'omit=' + omit + '&';  
         }  
         url += 'element=' + elementname + '';  
         var title = 'Browser';  
         var options = 'scrollbars=1,resizable=1,menubar=0';  
         options += ',width=700,height=600';  
         editbrowser = open(url,title,options,'1');  
         editbrowser.focus();  
     }  
     var editsearcher;  
     function opensearcher(formname,elementname) {  
         var url = '/adm/searchcat?';  
         if (editsearcher == null) {  
             url += 'launch=1&';  
         }  
         url += 'catalogmode=interactive&';  
         url += 'mode=edit&';  
         url += 'form=' + formname + '&';  
         url += 'element=' + elementname + '';  
         var title = 'Search';  
         var options = 'scrollbars=1,resizable=1,menubar=0';  
         options += ',width=700,height=600';  
         editsearcher = open(url,title,options,'1');  
         editsearcher.focus();  
     }      }
 </script>      my $discussion;
 ENDBROWSERSCRIPT      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
      ['LONCAPA_INTERNAL_no_discussion']);
       if (
              (   (!exists($env{'form.LONCAPA_INTERNAL_no_discussion'})) 
               || ($env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true')
              ) 
           && ($env{'form.inhibitmenu'} ne 'yes')
          ) {
           $discussion=&Apache::lonfeedback::list_discussion($mode,$status);
       }
       if ($target eq 'tex') {
    $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
    &Apache::lonxml::newparser($parser,\$discussion,'');
    return '';
     }      }
     return $result;  
 }  
   
 sub loadevents() {  
     return 'LONCAPAreg();';  
 }  
   
 sub unloadevents() {      return $discussion;
     return 'LONCAPAstale();';  
 }  }
   
 sub printalltags {  sub printalltags {
   my $temp;      foreach my $temp (sort(keys(%Apache::lonxml::alltags))) {
   foreach $temp (sort keys %Apache::lonxml::alltags) {          &Apache::lonxml::debug("$temp -- ".
     &Apache::lonxml::debug("$temp -- ".                                 join(',',@{ $Apache::lonxml::alltags{$temp} }));
   join(',',@{ $Apache::lonxml::alltags{$temp} }));      }
   }  
 }  }
   
 sub xmlparse {  sub xmlparse {
  my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;   my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
   
  &setup_globals($request,$target);   &setup_globals($request,$target);
  #&printalltags();   &Apache::inputtags::initialize_inputtags();
    &Apache::bridgetask::initialize_bridgetask();
    &Apache::outputtags::initialize_outputtags();
    &Apache::edit::initialize_edit();
    &Apache::londefdef::initialize_londefdef();
   
   #
   # do we have a course style file?
   #
   
    if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') {
        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:/[^/]*$::;
  &newparser(\@pars,\$content_file_string,$pwd);   &newparser(\@pars,\$content_file_string,$pwd);
   
Line 538  sub xmlparse { Line 288  sub xmlparse {
   
  my @stack = ();   my @stack = ();
  my @parstack = ();   my @parstack = ();
  &initdepth;   &initdepth();
    &init_alarm();
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target);     $safeeval,\%style_for_target,1);
  if ($ENV{'request.uri'}) {  
     &writeallows($ENV{'request.uri'});  
  }  
  return $finaloutput;  
 }  
   
 sub htmlclean {  
     my ($raw,$full)=@_;  
   
     my $tree = HTML::TreeBuilder->new;   if (@stack) {
     $tree->ignore_unknown(0);       &warning(&mt('At end of file some tags were still left unclosed:').
         ' <tt>&lt;'.join('&gt;</tt>, <tt>&lt;',reverse(@stack)).
         '&gt;</tt>');
    }
    if ($env{'request.uri'}) {
       &writeallows($env{'request.uri'});
    }
    &do_registered_ssi();
    if ($Apache::lonxml::counter_changed) { &store_counter() }
   
     $tree->parse($raw);   &clean_safespace($safeeval);
   
     my $output= $tree->as_HTML(undef,' ');   if (@script_var_displays) {
        if ($finaloutput =~ m{</body>\s*</html>\s*$}s) {
            my $scriptoutput = join('',@script_var_displays);
            $finaloutput=~s{(</body>\s*</html>)\s*$}{$scriptoutput$1}s;
        } else {
            $finaloutput .= join('',@script_var_displays);
        }
        undef(@script_var_displays);
    }
    &init_state();
    if ($env{'form.return_only_error_and_warning_counts'}) {
        if ($env{'request.filename'}=~/\.(html|htm|xml)$/i) { 
           my $error=&verify_html($content_file_string);
           if ($error) { $errorcount++; }
        }
        return "$errorcount:$warningcount";
    }
    return $finaloutput;
   }
   
     $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis;  sub latex_special_symbols {
     $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;      my ($string,$where)=@_;
     unless ($full) {      #
        $output=~s/\<[\/]*(body|head|html)\>//gis;      #  If e.g. in verbatim mode, then don't substitute.
       #  but return original string.
       #
       if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
    return $string;
       }
       if ($where eq 'header') {
    $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
    $string =~ s/(\$|%|\{|\})/\\$1/g;
    $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/_/\\_/g;              # _ -> \_
    $string =~ s/\^/\\\^{}/g;          # ^ -> \^{} 
       } else {
    $string=~s/\\/\\ensuremath{\\backslash}/g;
    $string=~s/\\\%|\%/\\\%/g;
    $string=~s/\\\{|\{/\\{/g;
    $string=~s/\\}|}/\\}/g;
    $string=~s/\\ensuremath\\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
    $string=~s/\\\$|\$/\\\$/g;
    $string=~s/\\\_|\_/\\\_/g;
           $string=~s/([^\\]|^)(\~|\^)/$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/\\\&|\&/\\\&/g;
    $string=~s/\\\#|\#/\\\#/g;
           $string=~s/\|/\$\\mid\$/g;
   #single { or } How to escape?
     }      }
       return $string;
     $tree = $tree->delete;  
   
     return $output;  
 }  }
   
 sub inner_xmlparse {  sub inner_xmlparse {
   my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
   my $finaloutput = '';    my $finaloutput = '';
   my $result;    my $result;
   my $token;    my $token;
     my $dontpop=0;
     my $lastdontpop;
     my $lastendtag;
     my $startredirection = $Apache::lonxml::redirection;
   while ( $#$pars > -1 ) {    while ( $#$pars > -1 ) {
     while ($token = $$pars['-1']->get_token) {      while ($token = $$pars['-1']->get_token) {
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($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 590  sub inner_xmlparse { Line 399  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]"})) {
   my $lasttag=$$stack[-1];      $Apache::lonxml::usestyle=0;
   if ($token->[1] =~ /^$lasttag$/i) {      my $string=$$style_for_target{'/'.$token->[1]}.
     &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; as end tag to &lt;'.$$stack[-1].'&gt;');        '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
     last;      &Apache::lonxml::newparser($pars,\$string);
   } else {      $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
     &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; when looking for &lt;/'.$$stack[-1].'&gt; in file');      $Apache::lonxml::style_end_values='';
     &end_tag($stack,$parstack,$token);      $dontpop=1;
   }  
  }  
   
  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 {   } 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(&mt('Using tag [_1] on line [_2] as end tag to [_3]','&lt;/'.$token->[1].'&gt;','.$token->[3].','&lt;'.$$stack[-1].'&gt;'));
       last;
    } else {
                       &Apache::lonxml::warning(&mt('Found tag [_1] on line [_2] when looking for [_3] in file.','&lt;/'.$token->[1].'&gt;',$token->[3],'&lt;/'.$$stack[-1].'&gt;'));
       &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;
   $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);    if (!$Apache::lonxml::usestyle) {
  } else {        $extras=$Apache::lonxml::style_values;
   $result= &Apache::run::evaluate($result,$safeeval,'');    }
  }    if ( $#$parstack > -1 ) {
         $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
     } else {
         $result= &Apache::run::evaluate($result,$safeeval,$extras);
             }
       }        }
       # Encode any high ASCII characters        $Apache::lonxml::post_evaluate=1;
       if (!$Apache::lonxml::prevent_entity_encode) {  
  $result=&HTML::Entities::encode($result,"\200-\377");        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) {        if ($Apache::lonxml::redirection) {
  $Apache::lonxml::outputstack['-1'] .= $result;   $Apache::lonxml::outputstack['-1'] .= $result;
       } else {        } else {
Line 652  sub inner_xmlparse { Line 467  sub inner_xmlparse {
       }        }
       $result = '';        $result = '';
   
       if ($token->[0] eq 'E') {         if ($token->[0] eq 'E') {
  &end_tag($stack,$parstack,$token);            if ($dontpop) {
                 $lastdontpop = $token; 
             } else {
                 $lastendtag = $token->[1];
                 &end_tag($stack,$parstack,$token);
             }
       }        }
         $dontpop=0;
       }
       if ($#$pars > -1) {
    pop @$pars;
    pop @Apache::lonxml::pwd;
     }      }
     pop @$pars;  
     pop @Apache::lonxml::pwd;  
   }    }
   
     if (($#$stack == 0) && ($stack->[0] eq 'physnet') && ($target eq 'web') && 
         ($lastendtag eq 'LONCAPA_INTERNAL_TURN_STYLE_ON')) {
          if ((ref($lastdontpop) eq 'ARRAY') && ($lastdontpop->[1] eq 'physnet')) {
              &end_tag($stack,$parstack,$lastdontpop);
          }
      }
   
   # if ($target eq 'meta') {    # if ($target eq 'meta') {
   #   $finaloutput.=&endredirection;    #   $finaloutput.=&endredirection;
   # }    # }
   
     if ( $start && $target eq 'grade') { &endredirection(); }
     if ( $Apache::lonxml::redirection > $startredirection) {
         while ($Apache::lonxml::redirection > $startredirection) {
     $finaloutput .= &endredirection();
         }
     }
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }    }
     if ($target eq 'modified') {
   # if modfied, handle startpart and endpart
        $finaloutput=~s/\<startpartmarker[^\>]*\>(.*)\<endpartmarker[^\>]*\>/<part>$1<\/part>/gs;
     }    
   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)) {  
   my $lasttag=$innerstack[-1];  
   if ($tokenpat->[1] =~ /^$lasttag$/i) {  
     &Apache::lonxml::warning('Using tag &lt;/'.$tokenpat->[1].'&gt; as end tag to &lt;'.$innerstack[-1].'&gt;');  
     last;  
   } else {  
     &Apache::lonxml::warning('Found tag &lt;/'.$tokenpat->[1].'&gt; when looking for &lt;/'.$innerstack[-1].'&gt; in file');  
     &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 751  sub callsub { Line 522  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 759  sub callsub { Line 532  sub callsub {
     }      }
   
     my $deleted=0;      my $deleted=0;
     $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);  
     if (($token->[0] eq 'S') && ($target eq 'modified')) {      if (($token->[0] eq 'S') && ($target eq 'modified')) {
       $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,        $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
      $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
Line 773  sub callsub { Line 545  sub callsub {
      $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
      $style);       $style);
       } else {        } else {
             if ($target eq 'tex') {
                 # throw away tag name
                 return '';
             }
  #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");   #&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)) {
Line 785  sub callsub { Line 561  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') {
     $currentstring = &Apache::edit::tag_end($target,$token);      $currentstring = &Apache::edit::tag_end($target,$token);
   }    }
  } elsif ($target eq 'modified') {   }
         }
         if ($target eq 'modified' && $nodefault eq '') {
     if ($currentstring eq '') {
         if ($token->[0] eq 'S') {
     $currentstring = $token->[4];
         } elsif ($token->[0] eq 'E') {
     $currentstring = $token->[2];
         } else {
     $currentstring = $token->[2];
         }
     }
   if ($token->[0] eq 'S') {    if ($token->[0] eq 'S') {
     $currentstring = $token->[4];        $currentstring.=&Apache::edit::handle_insert();
     $currentstring.=&Apache::edit::handle_insert();    } elsif ($token->[0] eq 'E') {
   } else {        $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
     $currentstring = $token->[2];  
   }    }
  }  
       }        }
     }      }
     use strict 'refs';      use strict 'refs';
Line 806  sub callsub { Line 591  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   {
       my %state;
   
       sub init_state {
    undef(%state);
       }
       
       sub set_state {
    my ($key,$value) = @_;
    $state{$key} = $value;
    return $value;
       }
       sub get_state {
    my ($key) = @_;
    return $state{$key};
       }
   }
   
 sub setup_globals {  sub setup_globals {
   my ($request,$target)=@_;    my ($request,$target)=@_;
   $Apache::lonxml::request=$request;    $Apache::lonxml::request=$request;
   $Apache::lonxml::registered = 0;    $errorcount=0;
     $warningcount=0;
     $Apache::lonxml::internal_error=0;
     $Apache::lonxml::default_homework_loaded=0;
     $Apache::lonxml::usestyle=1;
     &init_counter();
     &clear_bubble_lines_for_part();
     &init_state();
     &set_state('target',$target);
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @script_var_displays=();
     @Apache::lonxml::ssi_info=();
     $Apache::lonxml::post_evaluate=1;
     $Apache::lonxml::warnings_error_header='';
     $Apache::lonxml::substitute_LaTeX_symbols = 1;
   if ($target eq 'meta') {    if ($target eq 'meta') {
     $Apache::lonxml::redirection = 0;      $Apache::lonxml::redirection = 0;
     $Apache::lonxml::metamode = 1;      $Apache::lonxml::metamode = 1;
Line 823  sub setup_globals { Line 639  sub setup_globals {
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
   } elsif ($target eq 'grade') {    } elsif ($target eq 'grade') {
     &startredirection;      &startredirection(); #ended in inner_xmlparse on exit
     $Apache::lonxml::metamode = 0;      $Apache::lonxml::metamode = 0;
     $Apache::lonxml::evaluate = 1;      $Apache::lonxml::evaluate = 1;
     $Apache::lonxml::import = 1;      $Apache::lonxml::import = 1;
Line 852  sub setup_globals { Line 668  sub setup_globals {
   
 sub init_safespace {  sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;    my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->reval('use LaTeX::Table;');
     $safeeval->deny_only(':dangerous');
     $safeeval->reval('use LONCAPA::LCMathComplex;');
     $safeeval->permit_only(":default");
   $safeeval->permit("entereval");    $safeeval->permit("entereval");
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
     $safeeval->permit("time");
     $safeeval->permit("caller");
     $safeeval->deny("rand");
     $safeeval->deny("srand");
   $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(\&Apache::response::check_status,$safeeval,'&check_status');
     $safehole->wrap(\&Apache::response::implicit_multiplication,$safeeval,'&implicit_multiplication');
   
     $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval');
     $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check');
     $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval,
     '&maxima_cas_formula_fix');
   
     $safehole->wrap(\&Apache::lonr::r_eval,$safeeval,'&r_eval');
     $safehole->wrap(\&Apache::lonr::Rentry,$safeeval,'&Rentry');
     $safehole->wrap(\&Apache::lonr::Rarray,$safeeval,'&Rarray');
     $safehole->wrap(\&Apache::lonr::r_check,$safeeval,'&r_check');
     $safehole->wrap(\&Apache::lonr::r_cas_formula_fix,$safeeval,
                     '&r_cas_formula_fix');
    
     $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval,
     '&capa_formula_fix');
   
     $safehole->wrap(\&Apache::lonlocal::locallocaltime,$safeeval,
                     '&locallocaltime');
   
   $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 878  sub init_safespace { Line 725  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::Matrix::mat,$safeeval,'&mat');
     $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval,
     '&Math::Cephes::Matrix::new');
     $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval,
     '&Math::Cephes::Matrix::coef');
     $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval,
     '&Math::Cephes::Matrix::clr');
     $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval,
     '&Math::Cephes::Matrix::add');
     $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval,
     '&Math::Cephes::Matrix::sub');
     $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval,
     '&Math::Cephes::Matrix::mul');
     $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval,
     '&Math::Cephes::Matrix::div');
     $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval,
     '&Math::Cephes::Matrix::inv');
     $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval,
     '&Math::Cephes::Matrix::transp');
     $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval,
     '&Math::Cephes::Matrix::simq');
     $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval,
     '&Math::Cephes::Matrix::mat_to_vec');
     $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval,
     '&Math::Cephes::Matrix::vec_to_mat');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
   
   #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
   #  $safehole->wrap(\&Math::Cephes::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 899  sub init_safespace { Line 807  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::loncommon::languages,$safeeval,'&languages');
     $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
     $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
     $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
     $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');
     $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_val,$safeeval,'&fpr_val');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_f,$safeeval,'&fpr_f');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_dfdx,$safeeval,'&fpr_dfdx');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_d2fdx2,$safeeval,'&fpr_d2fdx2');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorcoords,$safeeval,'&fpr_vectorcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_objectcoords,$safeeval,'&fpr_objectcoords');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorlength,$safeeval,'&fpr_vectorlength');
     $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorangle,$safeeval,'&fpr_vectorangle');
     $safehole->wrap(\&Math::Calculus::Expression::math_calculus_expression,$safeeval,'&math_calculus_expression');
     $safehole->wrap(\&Number::FormatEng::format_eng,$safeeval,'&number_format_eng');
     $safehole->wrap(\&Number::FormatEng::format_pref,$safeeval,'&number_format_pref');
   
   #  use Data::Dumper;
   #  $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');
 #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 ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();  
   $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);  
   $safeinit .= ';$external::randomseed='.$rndseed.';';  
   &Apache::run::run($safeinit,$safeeval);    &Apache::run::run($safeinit,$safeeval);
     my $rawrndseed = &initialize_rndseed($safeeval);
     if ($target eq 'grade') {
         $Apache::lonhomework::rawrndseed = $rawrndseed;
     }
   }
   
   sub clean_safespace {
       my ($safeeval) = @_;
       delete_package_recurse($safeeval->{Root});
   }
   
   sub delete_package_recurse {
        my ($package) = @_;
        my @subp;
        {
    no strict 'refs';
    while (my ($key,$val) = each(%{*{"$package\::"}})) {
        if (!defined($val)) { next; }
        local (*ENTRY) = $val;
        if (defined *ENTRY{HASH} && $key =~ /::$/ &&
    $key ne "main::" && $key ne "<none>::")
        {
    my ($p) = $package ne "main" ? "$package\::" : "";
    ($p .= $key) =~ s/::$//;
    push(@subp,$p);
        }
    }
        }
        foreach my $p (@subp) {
    delete_package_recurse($p);
        }
        Symbol::delete_package($package);
   }
   
   sub initialize_rndseed {
       my ($safeeval)=@_;
       my $rndseed;
       my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
       $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
       my $safeinit = '$external::randomseed="'.$rndseed.'";';
       &Apache::lonxml::debug("Setting rndseed to $rndseed");
       &Apache::run::run($safeinit,$safeeval);
       return $rndseed;
   }
   
   sub default_homework_load {
       my ($safeeval)=@_;
       &Apache::lonxml::debug('Loading default_homework');
       my $default=&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonIncludes'}.
                                            '/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 $alarm_depth;
       sub init_alarm {
    alarm(0);
    $alarm_depth=0;
       }
   
       sub start_alarm {
    if ($alarm_depth<1) {
       my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
       if ($old) {
    &Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur.");
       }
    }
    $alarm_depth++;
       }
   
       sub end_alarm {
    $alarm_depth--;
    if ($alarm_depth<1) { alarm(0); }
       }
   }
   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 debugging 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 in_redirection {
       return ($Apache::lonxml::redirection > 0)
 }  }
   
 sub end_tag {  sub end_tag {
Line 933  sub end_tag { Line 946  sub end_tag {
   
 sub initdepth {  sub initdepth {
   @Apache::lonxml::depthcounter=();    @Apache::lonxml::depthcounter=();
   $Apache::lonxml::depth=-1;    undef($Apache::lonxml::last_depth_count);
   $Apache::lonxml::olddepth=-1;  
 }  }
   
   
   my @timers;
   my $lasttime;
   # @Apache::lonxml::depthcounter -> count of tags that exist so
   #                                  far at each level
   # $Apache::lonxml::last_depth_count -> when ascending, need to
   # remember the count for the level below the current level (for
   # example going from 1_2 -> 1 -> 1_3 need to remember the 2 )
   
 sub increasedepth {  sub increasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth++;    push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1);
   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;    undef($Apache::lonxml::last_depth_count);
   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {    my $time;
     $Apache::lonxml::olddepth=$Apache::lonxml::depth;    if ($Apache::lonxml::debug eq "1") {
   }        push(@timers,[&gettimeofday()]);
   my $curdepth=join('_',@Apache::lonxml::depthcounter);        $time=&tv_interval($lasttime);
   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");        $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x($#Apache::lonxml::depthcounter);
     $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
   #  &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time");
 #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";
 }  }
   
 sub decreasedepth {  sub decreasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth--;    if (  $#Apache::lonxml::depthcounter == -1) {
   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {        &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     $#Apache::lonxml::depthcounter--;  
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;  
   }    }
   if (  $Apache::lonxml::depth < -1) {    $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);
     &Apache::lonxml::warning("Missing tags, unable to properly run file.");  
     $Apache::lonxml::depth='-1';    my ($timer,$time);
   }    if ($Apache::lonxml::debug eq "1") {
   my $curdepth=join('_',@Apache::lonxml::depthcounter);        $timer=pop(@timers);
   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");        $time=&tv_interval($lasttime);
         $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x($#Apache::lonxml::depthcounter);
     $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
   #  &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
 #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_id {
       my ($parstack,$safeeval)=@_;
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\s\-])/) {
    &error(&mt('ID [_1] contains invalid characters. IDs are only allowed to contain letters, numbers, spaces and -','"<tt>'.$id.'</tt>"'));
       }
       if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
       return $id;
   }
   
   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')) {
       if ($token->[0] eq 'T' && $token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $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)= @_;  }
  my $depth=0;  
  my $token;  #########################################################################
  my $result='';  #                                                                       #
  if ( $tag =~ m:^/: ) {   #           bubble line counter management                              #
    my $tag=substr($tag,1);   #                                                                       #
 #   &Apache::lonxml::debug("have:$tag:");  #########################################################################
    while (($depth >=0) && ($token = $pars->get_token)) {  
 #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");  =pod
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {  
        $result.=$token->[1];  For bubble grading mode and exam bubble printing mode, the tracking of
      } elsif ($token->[0] eq 'PI') {  the current 'bubble line number' is stored in the %env element
        $result.=$token->[2];  'form.counter', and is modifed and handled by the following routines.
      } elsif ($token->[0] eq 'S') {  
        if ($token->[1] =~ /^$tag$/i) { $depth++; }  The value of it is stored in $Apache:lonxml::counter when live and
        $result.=$token->[4];  stored back to env after done.
      } elsif ($token->[0] eq 'E')  {  
        if ( $token->[1] =~ /^$tag$/i) { $depth--; }  =item &increment_counter($increment, $part_response);
        #skip sending back the last end tag  
        if ($depth > -1) { $result.=$token->[2]; } else {  Increments the internal counter environment variable a specified amount
  $pars->unget_token($token);  
        }  Optional Arguments:
      }    $increment - amount to increment by (defaults to 1)
    }                 Also 1 if the value is negative or zero.
  } else {    $part_response - A concatenation of the part and response id
    while ($token = $pars->get_token) {                     identifying exactly what is being 'answered'.
 #     &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];  =cut
      } elsif ($token->[0] eq 'PI') {  
        $result.=$token->[2];  sub increment_counter {
      } elsif ($token->[0] eq 'S') {      my ($increment, $part_response) = @_;
        if ( $token->[1] =~ /^$tag$/i) {      if ($env{'form.grade_noincrement'}) { return; }
  $pars->unget_token($token); last;      if (!defined($increment) || $increment le 0) {
        } else {   $increment = 1;
  $result.=$token->[4];      }
        }      $Apache::lonxml::counter += $increment;
      } elsif ($token->[0] eq 'E')  {  
        $result.=$token->[2];      # If the caller supplied the response_id parameter, 
      }      # Maintain its counter.. creating if necessary.
    }  
  }      if (defined($part_response)) {
 # &Apache::lonxml::debug("Exit:$result:");   if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
  return $result      $Apache::lonxml::counters_per_part{$part_response} = 0;
    }
    $Apache::lonxml::counters_per_part{$part_response} += $increment;
    my $new_value = $Apache::lonxml::counters_per_part{$part_response};
       }
   
       $Apache::lonxml::counter_changed=1;
   }
   
   =pod
   
   =item &init_counter($increment);
   
   Initialize the internal counter environment variable
   
   =cut
   
   sub init_counter {
       if ($env{'request.state'} eq 'construct') {
    $Apache::lonxml::counter=1;
    $Apache::lonxml::counter_changed=1;
       } elsif (defined($env{'form.counter'})) {
    $Apache::lonxml::counter=$env{'form.counter'};
    $Apache::lonxml::counter_changed=0;
       } else {
    $Apache::lonxml::counter=1;
    $Apache::lonxml::counter_changed=1;
       }
   }
   
   sub store_counter {
       &Apache::lonnet::appenv({'form.counter' => $Apache::lonxml::counter});
       $Apache::lonxml::counter_changed=0;
       return '';
   }
   
   {
       my $state;
       sub clear_problem_counter {
    undef($state);
    &Apache::lonnet::delenv('form.counter');
    &Apache::lonxml::init_counter();
    &Apache::lonxml::store_counter();
       }
   
       sub remember_problem_counter {
    &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
    $state = $env{'form.counter'};
       }
   
       sub restore_problem_counter {
    if (defined($state)) {
       &Apache::lonnet::appenv({'form.counter' => $state});
    }
       }
       sub get_problem_counter {
    if ($Apache::lonxml::counter_changed) { &store_counter() }
    &Apache::lonnet::transfer_profile_to_env(undef,undef,1);
    return $env{'form.counter'};
       }
   }
   
   =pod
   
   =item  bubble_lines_for_part(part_response)
   
   Returns the number of lines required to get a response for
   $part_response (this is just $Apache::lonxml::counters_per_part{$part_response}
   
   =cut
   
   sub bubble_lines_for_part {
       my ($part_response) = @_;
   
       if (!defined($Apache::lonxml::counters_per_part{$part_response})) {
    return 0;
       } else {
    return $Apache::lonxml::counters_per_part{$part_response};
       }
   }
   
   =pod
   
   =item clear_bubble_lines_for_part
   
   Clears the hash of bubble lines per part.  If a caller
   needs to analyze several resources this should be called between
   resources to reset the hash for each problem being analyzed.
   
   =cut
   
   sub clear_bubble_lines_for_part {
       undef(%Apache::lonxml::counters_per_part);
   }
   
   =pod
   
   =item set_bubble_lines(part_response, value)
   
   If there is a problem part, that for whatever reason
   requires bubble lines that are not
   the same as the counter increment, it can call this sub during
   analysis to set its hash value explicitly.
   
   =cut
   
   sub set_bubble_lines {
       my ($part_response, $value) = @_;
   
       $Apache::lonxml::counters_per_part{$part_response} = $value;
   }
   
   =pod
   
   =item get_bubble_line_hash
   
   Returns the current bubble line hash.  This is assumed to 
   be small so we return a copy
   
   
   =cut
   
   sub get_bubble_line_hash {
       return %Apache::lonxml::counters_per_part;
   }
   
   
   #--------------------------------------------------
   
   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')) {
       if ($token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $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')) {
       if ($token->[2]) {
    $result.='<![CDATA['.$token->[1].']]>';
       } else {
    $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::LCParser->new($contentref));    push (@$parser,HTML::LCParser->new($contentref));
   $$parser['-1']->xml_mode('1');    $$parser[-1]->xml_mode(1);
     $$parser[-1]->marked_sections(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 (@vars,@values);
   foreach (@{$token->[3]}) {      foreach my $attr (@{$token->[3]}) {
     unless ($_=~/\W/) {   if ($attr!~/\W/) {
       my $val=$token->[2]->{$_};      my $val=$token->[2]->{$attr};
       $val =~ s/([\%\@\\\"])/\\$1/g;      $val =~ s/([\%\@\\\"\'])/\\$1/g;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }      $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
       $temp .= "my \$$_=\"$val\";"      $val =~ s/(\$)$/\\$1/;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       push(@vars,"\$$attr");
       push(@values,"\"$val\"");
    }
     }      }
   }      my $var_init = 
   return $temp;   (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');'
           : '';
       return $var_init;
   }
   
   sub extlink {
       my ($res,$exact)=@_;
       if (!$exact) {
    $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);
       }
       push(@Apache::lonxml::extlinks,$res);
 }  }
   
 sub writeallows {  sub writeallows {
     unless ($#extlinks>=0) { return; }      unless ($#extlinks>=0) { return; }
     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);      my $thisurl = &Apache::lonnet::clutter(shift);
     if ($ENV{'httpref.'.$thisurl}) {      if ($env{'httpref.'.$thisurl}) {
  $thisurl=$ENV{'httpref.'.$thisurl};   $thisurl=$env{'httpref.'.$thisurl};
     }      }
     my $thisdir=$thisurl;      my $thisdir=$thisurl;
     $thisdir=~s/\/[^\/]+$//;      $thisdir=~s/\/[^\/]+$//;
     my %httpref=();      my %httpref=();
     foreach (@extlinks) {      foreach (@extlinks) {
        $httpref{'httpref.'.         $httpref{'httpref.'.
          &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;           &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
     }      }
     @extlinks=();      @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);
       }
   }
   
   sub add_script_result {
       my ($display) = @_;
       if ($display ne '') {
           push(@script_var_displays, $display);
       }
 }  }
   
 #  #
Line 1064  sub afterburn { Line 1397  sub afterburn {
     my $result=shift;      my $result=shift;
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['highlight','anchor','link']);      ['highlight','anchor','link']);
     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'}) {
        foreach (split(/\,/,$ENV{'form.link'})) {         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/(\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 1096  ENDSCRIPT Line 1429  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(&mt('Unable to save file [_1]','<tt>'.$file.'</tt>'));
    return 0;
     }      }
 }  }
   
 sub createnewhtml {  sub createnewhtml {
   my $filecontents=(<<SIMPLECONTENT);      my $title=&mt('Title of document goes here');
       my $body=&mt('Body of document goes here');
       my $filecontents=(<<SIMPLECONTENT);
 <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;    return $filecontents;
 }  }
   
   sub createnewjs {
       my $filecontents=(<<SIMPLECONTENT);
   <script type="text/javascript" language="Javascript">
   
   </script>
   SIMPLECONTENT
       return $filecontents;
   }
   
   sub verify_html {
       my ($filecontents)=@_;
       my ($is_html,$is_xml,$is_physnet);
       if ($filecontents =~/(?:\<|\&lt\;)\?xml[^\<]*\?(?:\>|\&gt\;)/is) {
           $is_xml = 1;
       } elsif ($filecontents =~/(?:\<|\&lt\;)html(?:\s+[^\<]+|\s*)(?:\>|\&gt\;)/is) {
           $is_html = 1;
       } elsif ($filecontents =~/(?:\<|\&lt\;)physnet[^\<]*(?:\>|\&gt\;)/is) {
           $is_physnet = 1;
       }
       unless ($is_xml || $is_html || $is_physnet) {
           return &mt('File does not have [_1] or [_2] starting tag','&lt;html&gt;','&lt;?xml ?&gt;');
       }
       if ($is_html) {
           if ($filecontents!~/(?:\<|\&lt\;)\/html(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] ending tag','&lt;html&gt;');
           }
           if ($filecontents!~/(?:\<|\&lt\;)(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] or [_2] starting tag','&lt;body&gt;','&lt;frameset&gt;');
           }
           if ($filecontents!~/(?:\<|\&lt\;)\/(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) {
               return &mt('File does not have [_1] or [_2] ending tag','&lt;body&gt;','&lt;frameset&gt;');
           }
       }
       return '';
   }
   
   sub renderingoptions {
       my %langchoices=('' => '');
       foreach (&Apache::loncommon::languageids()) {
           if (&Apache::loncommon::supportedlanguagecode($_)) {
               $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
                          = &Apache::loncommon::plainlanguagedescription($_);
           }
       }
       my $output;
       unless ($env{'form.forceedit'}) {
          $output .=
              '<span class="LC_nobreak">'.
              &mt('Language:').' '.
              &Apache::loncommon::select_form(
                  $env{'form.languages'},
                  'languages',
                  {&Apache::lonlocal::texthash(%langchoices)}).
              '</span>';
       }
       $output .=
        ' <span class="LC_nobreak">'.
          &mt('Math Rendering:').' '.
          &Apache::loncommon::select_form(
              $env{'form.texengine'},
              'texengine',
              {&Apache::lonlocal::texthash
                  (''        => '',
                   'tth'     => 'tth (TeX to HTML)',
                   'MathJax' => 'MathJax',
                   'mimetex' => 'mimetex (Convert to Images)')}).
        '</span>';
       return $output;
   }
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents)=@_;        my ($filecontents,$filetype,$filename,$symb,$itemtitle,$folderpath,$uri,$action) = @_;
       $filecontents = &HTML::Entities::encode($filecontents);        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';        my $xml_help = '';
       my $buttons=(<<BUTTONS);        my $initialize='';
 <input type="submit" name="attemptclean"         my $textarea_id = 'filecont';
        value="Save and then attempt to clean HTML" />        my ($dragmath_button,$deps_button,$context,$cnum,$cdom,$add_to_onload,
 <input type="submit" name="savethisfile" value="Save this" />            $add_to_onresize,$init_dragmath);
 <input type="submit" name="viewmode" value="View" />        $initialize=&Apache::lonhtmlcommon::spellheader();
 BUTTONS        if ($filetype eq 'html') {
             if ($env{'request.course.id'}) {
                 $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                 $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                 if ($uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E}) {
                     $context = 'syllabus';
                 }
             }
             if (&Apache::lonhtmlcommon::htmlareabrowser()) {
         my $lang = &Apache::lonhtmlcommon::htmlarea_lang();
                 my %textarea_args = (
                                       fullpage => 'true',
                                       dragmath => 'math',
                                     );
                 $initialize .= &Apache::lonhtmlcommon::htmlareaselectactive(\%textarea_args);
                 if ($context eq 'syllabus') {
                     $init_dragmath = "editmath_visibility('filecont','none')";
                 }
             }
         }
         $initialize .= (<<FULLPAGE);
   <script type="text/javascript">
   // <![CDATA[
       function initDocument() {
    resize_textarea('$textarea_id','LC_aftertextarea');
           $init_dragmath
       }
   // ]]>
   </script>
   FULLPAGE
         my $textareaclass;
         if ($filetype eq 'html') {
             if ($context eq 'syllabus') {
                 $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n";
                 $initialize .=
                     &Apache::lonhtmlcommon::dependencycheck_js(undef,&mt('Syllabus'),
                                                                $uri,undef,
                                                                "/public/$cdom/$cnum/syllabus").
                     "\n";
                 if (&Apache::lonhtmlcommon::htmlareabrowser()) {
                     $textareaclass = 'class="LC_richDefaultOn"';
                 }
             } elsif ($symb || $folderpath) {
                 $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n";
                 $initialize .= 
                     &Apache::lonhtmlcommon::dependencycheck_js($symb,$itemtitle,
                                                                undef,$folderpath,$uri)."\n";
             }
             $dragmath_button = '<span id="math_filecont">'.&Apache::lonhtmlcommon::dragmath_button('filecont',1).'</span>';
             $initialize .= "\n".&Apache::lonhtmlcommon::dragmath_js('EditMathPopup');
         }
         $add_to_onload = 'initDocument();';
         $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";
   
         if ($filetype eq 'html') {
             my $not_author;
             if ($uri =~ m{^/uploaded/}) {
                 $not_author = 1;
             }
     $xml_help=&Apache::loncommon::helpLatexCheatsheet(undef,undef,$not_author);
         }
   
         my $titledisplay=&display_title();
         my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit',
    'vi' => 'Save and View',
    'dv' => 'Discard Edits and View',
    'un' => 'Undo',
    'ed' => 'Edit',
    'ew' => 'Edit with Daxe');
         my $spelllink = &Apache::lonhtmlcommon::spelllink('xmledit','filecont');
         my $textarea_events = &Apache::edit::element_change_detection();
         my $form_events     = &Apache::edit::form_change_detection();
         my $htmlerror;
         if ($filetype eq 'html') {
             $htmlerror=&verify_html($filecontents);
             if ($htmlerror) {
                 $htmlerror=('&nbsp;'x3).' <span class="LC_error">'.$htmlerror.'</span>';
             }
             if (&Apache::lonhtmlcommon::htmlareabrowser()) {
                 unless ($textareaclass) {
                     $textareaclass = 'class="LC_richDefaultOff"';
                 }
             }
         }
         my ($undo,$daxebutton,%onclick);
         foreach my $item ('discard','undo','daxe') {
             $onclick{$item} = 'onclick="still_ask=true;setmode(this.form,'."'$item'".')"';
         }
         foreach my $item ('saveedit','saveview') {
             $onclick{$item} = 'onclick="is_submit=true;setmode(this.form,'."'$item'".')"';
         }
         unless ($uri =~ m{^/uploaded/}) {
             $undo = '<input type="button" name="Undo" accesskey="u" value="'.$lt{'un'}.'" '.
                     $onclick{'undo'}.' />'."\n";
         }
         $initialize .= &setmode_javascript();
         if ($filetype eq 'html') {
             my %editors = &Apache::loncommon::permitted_editors();
             if ($editors{'daxe'}) {
                 $daxebutton = '<input type="button" name="editwithdaxe" accesskey="w" value="'.$lt{'ew'}.'" '.
                               $onclick{'daxe'}.' />'."\n";
             }
         }
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
 <hr />  $initialize
 <a name="editsection" />  <a name="editsection" />
 <form method="post">  <form $form_events method="post" name="xmledit" action="$action">
 <input type="hidden" name="editmode" value="Edit" />    <input type="hidden" name="problemmode" value="edit" />
 $buttons<br />    <div class="LC_edit_problem_editxml_header">
 <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>      <table class="LC_edit_problem_header_title"><tr><td>
 <br />$buttons          $filename
 <br />        </td><td align="right">
           $xml_help
         </td></tr>
       </table>
       <div style="float:right">
         <input type="button" name="savethisfile" accesskey="s" value="$lt{'st'}" $onclick{'saveedit'} />
         <input type="button" name="viewmode" accesskey="v" value="$lt{'vi'}" $onclick{'saveview'} />
       </div>
       <div>
         <input type="button" name="discardview" accesskey="d" value="$lt{'dv'}" $onclick{'discard'} />
         $undo $deps_button $daxebutton $dragmath_button $htmlerror
       </div>
     </div>
     <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont" $textareaclass>$filecontents</textarea><br />$spelllink
     <div id="LC_aftertextarea">
       <br />
       $titledisplay
     </div>
 </form>  </form>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;        return ($editfooter,$add_to_onload,$add_to_onresize);
       $result=~s/(\<\/body\>)/$editfooter/is;  }
       return $result;  
   sub setmode_javascript {
       return <<"ENDSCRIPT";
   <script type="text/javascript">
   // <![CDATA[
   function setmode(form,probmode) {
       if (probmode == 'daxe') {
           var url = new URL(document.location.href);
           window.location = url.protocol+'//'+url.hostname+'/daxepage'+url.pathname;
       } else {
           var initial = form.problemmode.value;
           form.problemmode.value = probmode;
           form.submit();
           form.problemmode.value = initial;
       }
   }
   // ]]>
   </script>
   ENDSCRIPT
   }
   
   sub seteditor_javascript {
       return <<"ENDSCRIPT";
   <script type="text/javascript">
   // <![CDATA[
   function seteditmode(form,editor) {
       if (editor == 'daxe') {
           var url = new URL(document.location.href);
           window.location = url.protocol+'//'+url.hostname+'/daxepage'+url.pathname;
       } else {
           form.editmode.value = editor;
           form.submit();
       }
   }
   // ]]>
   </script>
   ENDSCRIPT
 }  }
   
 sub get_target {  sub get_target {
   my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});    my $viewgrades=&Apache::lonnet::allowed('vgr',$env{'request.course.id'});
   if ( $ENV{'request.state'} eq 'published') {    if ( $env{'request.state'} eq 'published') {
     if ( defined($ENV{'form.grade_target'})      if ( defined($env{'form.grade_target'})
  && ($viewgrades == 'F' )) {   && ($viewgrades == 'F' )) {
       return ($ENV{'form.grade_target'});        return ($env{'form.grade_target'});
     } elsif (defined($ENV{'form.grade_target'})) {      } elsif (defined($env{'form.grade_target'})) {
       if (($ENV{'form.grade_target'} eq 'web') ||        if (($env{'form.grade_target'} eq 'web') ||
   ($ENV{'form.grade_target'} eq 'tex') ) {    ($env{'form.grade_target'} eq 'tex') ) {
  return $ENV{'form.grade_target'}   return $env{'form.grade_target'}
       } else {        } else {
  return 'web';   return 'web';
       }        }
     } else {      } else {
       return 'web';        return 'web';
     }      }
   } elsif ($ENV{'request.state'} eq 'construct') {    } elsif ($env{'request.state'} eq 'construct') {
     if ( defined($ENV{'form.grade_target'})) {      if ( defined($env{'form.grade_target'})) {
       return ($ENV{'form.grade_target'});        return ($env{'form.grade_target'});
     } else {      } else {
       return 'web';        return 'web';
     }      }
Line 1177  sub get_target { Line 1747  sub get_target {
 }  }
   
 sub handler {  sub handler {
   my $request=shift;      my $request=shift;
   
   my $target=&get_target();  
   
   $Apache::lonxml::debug=0;      my $target=&get_target();
       $Apache::lonxml::debug=$env{'user.debug'};
   if ($ENV{'browser.mathml'}) {      
     $request->content_type('text/xml');      &Apache::loncommon::content_type($request,'text/html');
   } else {      &Apache::loncommon::no_cache($request);
     $request->content_type('text/html');      if ($env{'request.state'} eq 'published') {
   }   $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
   &Apache::loncommon::no_cache($request);        'lastrevisiondate'));
   $request->send_http_header;      }
       # Embedded Flash movies from Camtasia served from https will not display in IE
       #   if XML config file has expired from cache.    
       if ($ENV{'SERVER_PORT'} == 443) {
           if ($request->uri =~ /\.xml$/) {
               my ($httpbrowser,$clientbrowser) =
                   &Apache::loncommon::decode_user_agent($request);
               if ($clientbrowser =~ /^explorer$/i) {
                   delete $request->headers_out->{'Cache-control'};
                   delete $request->headers_out->{'Pragma'};
                   my $expiration = time + 60;
                   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime($expiration));
                   $request->headers_out->set("Expires" => $date);
               }
           }
       }
       $request->send_http_header;
       
       return OK if $request->header_only;
   
   return OK if $request->header_only;  
   
       my $file=&Apache::lonnet::filelocation("",$request->uri);
       my ($filetype,$breadcrumbtext);
       if ($file =~ /\.(sty|css|js|txt|tex)$/) {
    $filetype=$1;
       } else {
    $filetype='html';
       }
       unless ($env{'request.uri'}) {
           $env{'request.uri'}=$request->uri;
           &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                   ['todocs']);
       }
       my ($cdom,$cnum);
       if ($env{'request.course.id'}) {
           $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           if ($filetype eq 'html') {
               if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E.+$}) {
                   if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                               ['editmode']);
                   }
               }
           }
       }
       if ($filetype eq 'sty') {
           $breadcrumbtext = 'Style File Editor';
       } elsif ($filetype eq 'js') {
           $breadcrumbtext = 'Javascript Editor';
       } elsif ($filetype eq 'css') {
           $breadcrumbtext = 'CSS Editor';
       } elsif ($filetype eq 'txt') {
           $breadcrumbtext = 'Text Editor';
       } elsif ($filetype eq 'tex') {
           $breadcrumbtext = 'TeX Editor';
       } else {
           $breadcrumbtext = 'HTML Editor';
       }
   
   my $file=&Apache::lonnet::filelocation("",$request->uri);  
 #  #
 # Edit action? Save file.  # Edit action? Save file.
 #  #
   unless ($ENV{'request.state'} eq 'published') {      if (!($env{'request.state'} eq 'published')) {
       if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {          if (($env{'form.problemmode'} eq 'saveedit') ||
   &storefile($file,$ENV{'form.filecont'});              ($env{'form.problemmode'} eq 'saveview') ||
       }              ($env{'form.problemmode'} eq 'undo')) {
   }      my $html_file=&Apache::lonnet::getfile($file);
   my %mystyle;      my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'});
   my $result = '';              if ($env{'form.problemmode'} eq 'saveedit') {
   my $filecontents=&Apache::lonnet::getfile($file);                  $env{'form.editmode'}='edit'; #force edit mode
   if ($filecontents == -1) {              }
     $result=(<<ENDNOTFOUND);   }
 <html>  
 <head>  
 <title>File not found</title>  
 </head>  
 <body bgcolor="#FFFFFF">  
 <b>File not found: $file</b>  
 </body>  
 </html>  
 ENDNOTFOUND  
     $filecontents='';  
     if ($ENV{'request.state'} ne 'published') {  
       $filecontents=&createnewhtml();  
       $ENV{'form.editmode'}='Edit'; #force edit mode  
     }  
   } else {  
     unless ($ENV{'request.state'} eq 'published') {  
       if ($ENV{'form.attemptclean'}) {  
  $filecontents=&htmlclean($filecontents,1);  
       }  
     }      }
     if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {      my $inhibit_menu;
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,      my %mystyle;
   '',%mystyle);      my $result = '';
       my $filecontents=&Apache::lonnet::getfile($file);
       if ($filecontents eq -1) {
    my $start_page=&Apache::loncommon::start_page('File Error');
    my $end_page=&Apache::loncommon::end_page();
           my $errormsg='<p class="LC_error">'
                       .&mt('File not found: [_1]'
                           ,'<span class="LC_filename">'.$file.'</span>')
                       .'</p>';
    $result=(<<ENDNOTFOUND);
   $start_page
   $errormsg
   $end_page
   ENDNOTFOUND
           $filecontents='';
    if ($env{'request.state'} ne 'published') {
       if ($filetype eq 'sty') {
    $filecontents=&createnewsty();
               } elsif ($filetype eq 'js') {
                   $filecontents=&createnewjs();
               } elsif ($filetype ne 'css' && $filetype ne 'txt' && $filetype ne 'tex') {
    $filecontents=&createnewhtml();
       }
       $env{'form.editmode'}='edit'; #force edit mode
    }
       } else {
    unless ($env{'request.state'} eq 'published') {
       if ($filecontents=~/BEGIN LON-CAPA Internal/) {
    &Apache::lonxml::error(&mt('This file appears to be a rendering of a LON-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.'));
       }
   #
   # 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.problemmode'} eq 'saveview') ||
               ($env{'form.problemmode'} eq 'discard')) {
               if ($filetype eq 'html' || $filetype eq 'sty') {
           &Apache::structuretags::reset_problem_globals();
           $result = &Apache::lonxml::xmlparse($request,$target,
                                                       $filecontents,'',%mystyle);
       # .html files may contain <problem> or <Task> need to clean
       # up if it did
           &Apache::structuretags::reset_problem_globals();
           &Apache::lonhomework::finished_parsing();
               } elsif ($filetype eq 'tex') {
                   $result = &Apache::lontexconvert::converted(\$filecontents,
                                 $env{'form.texengine'});
                   if ($env{'form.return_only_error_and_warning_counts'}) {
                       $result = "$errorcount:$warningcount";
                   }
               } else {
                   $result = $filecontents;
               }
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
       ['rawmode']);
       if ($env{'form.rawmode'}) { $result = $filecontents; }
               if (($env{'request.state'} eq 'construct') &&
                   (($filetype eq 'css') || ($filetype eq 'js')) && ($ENV{'HTTP_REFERER'})) {
                   if ($ENV{'HTTP_REFERER'} =~ m{^https?\://[^\/]+/priv/$LONCAPA::match_domain/$LONCAPA::match_username/[^\?]+\.(x?html?|swf)(|\?)[^\?]*$}) {
                       $inhibit_menu = 1;
                   }
               }
               if (($filetype ne 'html') && 
                   (!$env{'form.return_only_error_and_warning_counts'}) &&
                   (!$inhibit_menu)) {
                   my $nochgview = 1;
                   my $controls = '';
                       if ($env{'request.state'} eq 'construct') {
                           $controls = &Apache::loncommon::head_subbox(
                                           &Apache::loncommon::CSTR_pageheader()
                                          .&Apache::londefdef::edit_controls($nochgview));
                       }
                   if ($filetype ne 'sty' && $filetype ne 'tex') {
                       $result =~ s/</&lt;/g;
                       $result =~ s/>/&gt;/g;
                       $result = '<table class="LC_sty_begin">'.
                                 '<tr><td><b><pre>'.$result.
                                 '</pre></b></td></tr></table>';
                   }
                   my $brcrum;
                   if ($env{'request.state'} eq 'construct') {
                       my $text = 'Authoring Space';
                       my $href = &Apache::loncommon::authorspace($request->uri);
                       if ($env{'request.course.id'}) {
                           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                           if ($href eq "/priv/$cdom/$cnum/") {
                               $text = 'Course Authoring Space';
                           }
                       }
                       $brcrum = [{'href' => $href,
                                   'text' => $text,},
                                  {'href' => '',
                                   'text' => $breadcrumbtext}];
                   } else {
                       $brcrum = ''; # FIXME: Where are we?
                   }
                   my %options = ('bread_crumbs' => $brcrum,
                                  'bgcolor'      => '#FFFFFF');
                   $result =
                       &Apache::loncommon::start_page(undef,undef,\%options)
                      .$controls
                      .$result
                      .&Apache::loncommon::end_page();
               }
           }
     }      }
   }  
   
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
   unless ($ENV{'request.state'} eq 'published') {      unless (($env{'request.state'} eq 'published') || ($inhibit_menu)) {
     if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {          if (($env{'form.editmode'}) &&
       $result='<html><body bgcolor="#FFFFFF"></body></html>';              (!($env{'form.problemmode'} eq 'saveview')) &&
       $result=&inserteditinfo($result,$filecontents);              (!($env{'form.problemmode'} eq 'discard'))) {
               my ($displayfile,$url,$symb,$itemtitle,$action);
       $displayfile=$request->uri;
               if ($request->uri =~ m{^/uploaded/}) {
                   if ($env{'request.course.id'}) {
                       if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/supplemental/\E}) {
                           &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                                                   ['folderpath','title']);
                       } elsif ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E(.+)$}) {
                           my $filename = $1;
                           if ($1 eq 'loncapa.html') {
                               $displayfile = &mt('Syllabus (minimal template)');
                               $action = $request->uri.'?forceedit=1';
                           } else {
                               $displayfile = &mt('Syllabus file: [_1]',$1);
                           }
                           $itemtitle = &mt('Syllabus');
                       }
                   }
                   unless ($itemtitle) {
                       ($symb,$itemtitle,$displayfile) = 
                           &get_courseupload_hierarchy($request->uri,
                                                       $env{'form.folderpath'},
                                                       $env{'form.title'});
                   }
               } else {
           $displayfile=~s/^\/[^\/]*//;
               }
   
       my ($edit_info, $add_to_onload, $add_to_onresize)=
    &inserteditinfo($filecontents,$filetype,$displayfile,$symb,
                                   $itemtitle,$env{'form.folderpath'},$request->uri,$action);
   
       my %options = 
    ('add_entries' =>
                      {'onresize'     => $add_to_onresize,
                       'onload'       => $add_to_onload,   });
               my $header;
               if ($env{'request.state'} eq 'construct') {
                   my $text = 'Authoring Space';
                   my $href = &Apache::loncommon::authorspace($request->uri);
                   if ($env{'request.course.id'}) {
                       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                       if ($href eq "/priv/$cdom/$cnum/") {
                           $text = 'Course Authoring Space';
                       }
                   }
                   $options{'bread_crumbs'} = [{
                               'href' => $href,
                               'text' => $text},
                              {'href' => '',
                               'text' => $breadcrumbtext}];
                   $header = &Apache::loncommon::head_subbox(
                                 &Apache::loncommon::CSTR_pageheader());
               }
       my $js =
    &Apache::edit::js_change_detection().
    &Apache::loncommon::resize_textarea_js();
       my $start_page = &Apache::loncommon::start_page(undef,$js,
       \%options);
               $result = $start_page
                        .$header
                        .&Apache::lonxml::message_location()
                        .$edit_info
                        .&Apache::loncommon::end_page();
           }
     }      }
   }      if ($filetype eq 'html') { &writeallows($request->uri); }
   
   writeallows($request->uri);      &Apache::lonxml::add_messages(\$result);
       $request->print($result);
       
       return OK;
   }
   
   $request->print($result);  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 "
                     .&mt('Authoring Space')."';</script>";
       }
       return $result;
   }
   
   return OK;  sub get_courseupload_hierarchy {
       my ($url,$folderpath,$title) = @_;
       my ($symb,$itemtitle,$displaypath);
       if ($env{'request.course.id'}) {
           if ($folderpath =~ /^supplemental/) {
               my @folders = split(/\&/,$folderpath);
               my @pathitems;
               while (@folders) {
                   my $folder=shift(@folders);
                   my $foldername=shift(@folders);
                   $foldername =~ s/\:(\d*)\:(\w*)\:(\w*):(\d*)\:?(\d*)$//;
                   push(@pathitems,&unescape($foldername));
               }
               if ($title) {
                   push(@pathitems,&unescape($title));
               }
               $displaypath = join(' &raquo; ',@pathitems);
           } else {
               $symb = &Apache::lonnet::symbread($url);
               my ($map,$id,$res)=&Apache::lonnet::decode_symb($symb);
               my $navmap=Apache::lonnavmaps::navmap->new;
               if (ref($navmap)) {
                   my $res = $navmap->getBySymb($symb);
                   if (ref($res)) {
                       my @pathitems =
                           &Apache::loncommon::get_folder_hierarchy($navmap,$map,1);
                       $itemtitle = $res->compTitle();
                       push(@pathitems,$itemtitle);
                       $displaypath = join(' &raquo; ',@pathitems);
                   }
               }
           }
       }
       return ($symb,$itemtitle,$displaypath);
 }  }
   
 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) {
       eval { $request=Apache->request; };
    }
    if (!$request) {
       eval { $request=Apache2::RequestUtil->request; };
    }
    $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
    #&Apache::lonnet::logthis($_[0]);
       }
   }
   
   sub show_error_warn_msg {
       if (($env{'request.filename'} eq 
            $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/lib/templates/simpleproblem.problem') &&
           (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) {
    return 1;
       }
       return (($Apache::lonxml::debug eq 1) ||
       ($env{'request.state'} eq 'construct') ||
       ($Apache::lonhomework::browse eq 'F'
        &&
        $env{'form.show_errors'} eq 'on'));
 }  }
   
 sub error {  sub error {
   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {      my @errors = @_;
     # If printing in construction space, put the error inside <pre></pre>  
     print "<b>ERROR:</b>".join("\n",@_)."\n";      $errorcount++;
   } else {  
     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";      $Apache::lonxml::internal_error=1;
     #notify author  
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));      if (defined($Apache::inputtags::part)) {
     #notify course   if ( @Apache::inputtags::response ) {
     if ( $ENV{'request.course.id'} ) {      push(@errors,
       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};   &mt("This error occurred while processing response [_1] in part [_2]",
       my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});       $Apache::inputtags::response[-1],
       foreach my $user (split /\,/, $users) {       $Apache::inputtags::part));
  ($user,my $domain) = split /:/, $user;   } else {
  &Apache::lonmsg::user_normal_msg($user,$domain,      push(@errors,
         "Error [$declutter]",join('<br />',@_));   &mt("This error occurred while processing part [_1]",
       }       $Apache::inputtags::part));
    }
     }      }
   
     #FIXME probably shouldn't have me get everything forever.      if ( &show_error_warn_msg() ) {
     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));   # If printing in construction space, put the error inside <pre></pre>
     #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);   push(@Apache::lonxml::error_messages,
   }       $Apache::lonxml::warnings_error_header
                .'<div class="LC_error">'
                .'<b>'.&mt('ERROR:').' </b>'.join("<br />\n",@errors)
                ."</div>\n");
    $Apache::lonxml::warnings_error_header='';
       } else {
    my $errormsg;
    my ($symb)=&Apache::lonnet::symbread();
    if ( !$symb ) {
       #public or browsers
       $errormsg=&mt("An error occurred while processing this resource. The author has been notified.");
    }
    my $host=$Apache::lonnet::perlvar{'lonHostID'};
    push(@errors,
           &mt("The error occurred on host [_1]",
                "<tt>$host</tt>"));
   
    my $msg = join('<br />', @errors);
   
    #notify author
    &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
    #notify course
    if ( $symb && $env{'request.course.id'} ) {
       my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
       my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
       my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1);
       my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
               my $baseurl = &Apache::lonnet::clutter($declutter);
       my @userlist;
       foreach (keys(%users)) {
    my ($user,$domain) = split(/:/, $_);
    push(@userlist,"$user:$domain");
    my $key=$declutter.'_'.$user.'_'.$domain;
    my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
         [$key],
         $cdom,$cnum);
    my $now=time;
    if ($now-$lastnotified{$key}>86400) {
                       my $title = &Apache::lonnet::gettitle($symb);
                       my $sentmessage;
       &Apache::lonmsg::user_normal_msg($user,$domain,
           "Error [$title]",$msg,'',$baseurl,'','',
                           \$sentmessage,$symb,$title,1);
       &Apache::lonnet::put('nohist_xmlerrornotifications',
    {$key => $now},
    $cdom,$cnum);
    }
       }
       if ($env{'request.role.adv'}) {
    $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
       } else {
    $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified.");
       }
    }
    push(@Apache::lonxml::error_messages,"<span class=\"LC_warning\">$errormsg</span><br />");
       }
 }  }
   
 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 ( &show_error_warn_msg() ) {
       push(@Apache::lonxml::warning_messages,
    $Apache::lonxml::warnings_error_header
                   .'<div class="LC_warning">'
                   .&mt('[_1]W[_2]ARNING','<b>','</b>')."<b>:</b> ".join('<br />',@_)
                   ."</div>\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, $noelide) = @_;
   if ( ! $context ) { $context = -1; }  
   my $args ='';      if ( ! $context ) { $context = -1; }
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }      my $args ='';
   if ( ! $args ) { return undef; }      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 ($noelide) {
   # $args =~ s/\\'/'/g;
    $args =~ s/'\$/'\\\$/g;
       }
   
       if ( ! $args ) { return undef; }
       if ( $case_insensitive ) {
    if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/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)/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 =~ /^[\$\@\%][a-zA-Z_]\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;
   }    }
 }  }
   
 sub register_insert {  sub register_insert_xml {
   my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');      my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
   my $i;       .'/insertlist.xml');
   my $tagnum=0;      my ($tagnum,$in_help)=(0,0);
   my @order;      my @alltags;
   for ($i=0;$i < $#data; $i++) {      my $tag;
     my $line = $data[$i];      while (my $token = $parser->get_token()) {
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }   if ($token->[0] eq 'S') {
     if ( $line =~ /TABLE/ ) { last; }      my $key;
     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);      if ($token->[1] eq 'tag') {
     if ($tag) {   $tag = $token->[2]{'name'};
       $insertlist{"$tagnum.tag"} = $tag;                  if (defined($tag)) {
       $insertlist{"$tagnum.description"} = $descrip;      $insertlist{$tagnum.'.tag'} = $tag;
       $insertlist{"$tagnum.color"} = $color;      $insertlist{$tag.'.num'}   = $tagnum;
       $insertlist{"$tagnum.function"} = $function;      push(@alltags,$tag);
       if (!defined($show)) { $show='yes'; }                  }
       $insertlist{"$tagnum.show"}= $show;      } elsif ($in_help && $token->[1] eq 'file') {
       $insertlist{"$tag.num"}=$tagnum;   $key = $tag.'.helpfile';
       $tagnum++;      } elsif ($in_help && $token->[1] eq 'description') {
    $key = $tag.'.helpdesc';
       } elsif ($token->[1] eq 'description' ||
        $token->[1] eq 'color'       ||
        $token->[1] eq 'show'          ) {
    $key = $tag.'.'.$token->[1];
       } elsif ($token->[1] eq 'insert_sub') {
    $key = $tag.'.function';
       } elsif ($token->[1] eq 'help') {
    $in_help=1;
       } elsif ($token->[1] eq 'allow') {
    $key = $tag.'.allow';
       }
       if (defined($key)) {
    $insertlist{$key} = $parser->get_text();
    $insertlist{$key} =~ s/(^\s*|\s*$ )//gx;
       }
    } elsif ($token->[0] eq 'E') {
       if      ($token->[1] eq 'tag') {
    undef($tag);
    $tagnum++;
       } elsif ($token->[1] eq 'help') {
    undef($in_help);
       }
    }
     }      }
   }      
   $i++; #skipping TABLE line      # parse the allows and ignore tags set to <show>no</show>
   $tagnum = 0;      foreach my $tag (@alltags) {
   for (;$i < $#data;$i++) {          next if (!exists($insertlist{$tag.'.allow'}));
     my $line = $data[$i];   my $allow =  $insertlist{$tag.'.allow'};
     my ($mnemonic,@which) = split(/ +/,$line);          foreach my $element (split(',',$allow)) {
     my $tag = $insertlist{"$tagnum.tag"};      $element =~ s/(^\s*|\s*$ )//gx;
     for (my $j=0;$j <=$#which;$j++) {      if (!exists($insertlist{$element.'.show'})
       if ( $which[$j] eq 'Y' ) {                  || $insertlist{$element.'.show'} ne 'no') {
  if ($insertlist{"$j.show"} ne 'no') {   push(@{ $insertlist{$tag.'.which'} },$element);
   push(@{ $insertlist{"$tag.which"} },$j);      }
  }   }
       }  
     }      }
     $tagnum++;  }
   }  
   sub register_insert {
       return &register_insert_xml(@_);
   #    &dump_insertlist('2');
   }
   
   sub dump_insertlist {
       my ($ext) = @_;
       open(XML,">","/tmp/insertlist.xml.$ext");
       print XML ("<insertlist>");
       my $i=0;
   
       while (exists($insertlist{"$i.tag"})) {
    my $tag = $insertlist{"$i.tag"};
    print XML ("
   \t<tag name=\"$tag\">");
    if (defined($insertlist{"$tag.description"})) {
       print XML ("
   \t\t<description>".$insertlist{"$tag.description"}."</description>");
    }
    if (defined($insertlist{"$tag.color"})) {
       print XML ("
   \t\t<color>".$insertlist{"$tag.color"}."</color>");
    }
    if (defined($insertlist{"$tag.function"})) {
       print XML ("
   \t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>");
    }
    if (defined($insertlist{"$tag.show"})
       && $insertlist{"$tag.show"} ne 'yes') {
       print XML ("
   \t\t<show>".$insertlist{"$tag.show"}."</show>");
    }
    if (defined($insertlist{"$tag.helpfile"})) {
       print XML ("
   \t\t<help>
   \t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>");
       if ($insertlist{"$tag.helpdesc"} ne '') {
    print XML ("
   \t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>");
       }
       print XML ("
   \t\t</help>");
    }
    if (defined($insertlist{"$tag.which"})) {
       print XML ("
   \t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>");
    }
    print XML ("
   \t</tag>");
    $i++;
       }
       print XML ("\n</insertlist>\n");
       close(XML);
 }  }
   
 sub description {  sub description {
   my ($token)=@_;      my ($token)=@_;
   my $tagnum;      my $tag = &get_tag($token);
   my $tag=$token->[1];      return $insertlist{$tag.'.description'};
   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'};  
 }  }
   
 # ----------------------------------------------------------------- whichuser  # Returns a list containing the help file, and the description
 # returns a list of $symb, $courseid, $domain, $name that is correct for  sub helpinfo {
 # calls to lonnet functions for this setup.      my ($token)=@_;
 # - looks for form.grade_ parameters      my $tag = &get_tag($token);
 sub whichuser {      return ($insertlist{$tag.'.helpfile'}, &mt($insertlist{$tag.'.helpdesc'}));
   my ($symb,$courseid,$domain,$name);  }
   if (defined($ENV{'form.grade_symb'})) {  
     my $tmp_courseid=$ENV{'form.grade_courseid'};  sub get_tag {
     my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);      my ($token)=@_;
     if ($allowed) {      my $tagnum;
       $symb=$ENV{'form.grade_symb'};      my $tag=$token->[1];
       $courseid=$ENV{'form.grade_courseid'};      foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
       $domain=$ENV{'form.grade_domain'};   my $testtag = $namespace.'::'.$tag;
       $name=$ENV{'form.grade_username'};   $tagnum = $insertlist{"$testtag.num"};
    last if (defined($tagnum));
     }      }
   } else {      if (!defined($tagnum)) {
     $symb=&Apache::lonnet::symbread();   $tagnum = $Apache::lonxml::insertlist{"$tag.num"};
     $courseid=$ENV{'request.course.id'};      }
     $domain=$ENV{'user.domain'};      return $insertlist{"$tagnum.tag"};
     $name=$ENV{'user.name'};  }
   }  
   return ($symb,$courseid,$domain,$name);  ############################################################
   #                                           PDF-FORM-METHODS
   
   =pod
   
   =item &print_pdf_radiobutton(fieldname, value)
   
   Returns a latexline to generate a PDF-Form-Radiobutton.
   Note: Radiobuttons with equal names are automaticly grouped 
         in a selection-group.
   
   $fieldname: PDF internalname of the radiobutton(group)
   $value:     Value of radiobutton
   
   =cut
   sub print_pdf_radiobutton {
       my ($fieldname, $value) = @_;
       return '\radioButton[\symbolchoice{circle}]{'
              .$fieldname.'}{10bp}{10bp}{'.$value.'}';
   }
   
   
   =pod
   
   =item &print_pdf_start_combobox(fieldname)
   
   Starts a latexline to generate a PDF-Form-Combobox with text.
   
   $fieldname: PDF internal name of the Combobox
   
   =cut
   sub print_pdf_start_combobox {
       my $result;
       my ($fieldName) = @_;
       $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n";
       $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; # 
   
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_add_combobox_option(options)
   
   Generates a latexline to add Options to a PDF-Form-ComboBox.
   
   $option: PDF internal name of the Combobox-Option
   
   =cut
   sub print_pdf_add_combobox_option {
   
       my $result;
       my ($option) = @_;  
   
       $result .= '('.$option.')';
       
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_end_combobox(text) {
   
   Returns latexcode to end a PDF-Form-Combobox with text.
   
   =cut
   sub print_pdf_end_combobox {
       my $result;
       my ($text) = @_;
   
       $result .= '}&'.$text."\\\\\n";
       $result .= '\end{tabularx}' . "\n";
       $result .= '\hspace{2mm}' . "\n";
       return $result;
   }
   
   
   =pod
   
   =item &print_pdf_hiddenField(fieldname, user, domain)
   
   Returns a latexline to generate a PDF-Form-hiddenField with userdata.
   
   $fieldname label for hiddentextfield
   $user:    name of user
   $domain:  domain of user
   
   =cut
   sub print_pdf_hiddenfield {
       my $result;
       my ($fieldname, $user, $domain) = @_;
   
       $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n";
   
       return $result;
 }  }
   
 1;  1;
 __END__  __END__
   
   
Removed from v.1.175  
changed lines
  Added in v.1.568

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