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

Diff for /loncom/xml/lonxml.pm between versions 1.52 and 1.222

version 1.52, 2001/02/13 00:17:11 version 1.222, 2002/12/26 16:40:33
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # XML Parser Module   # XML Parser Module 
 #  #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   # Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 
   # TtHfunc and TtMfunc (the "Code") may be compiled and linked into 
   # binary executable programs or libraries distributed by the 
   # Michigan State University (the "Licensee"), but any binaries so 
   # distributed are hereby licensed only for use in the context
   # of a program or computational system for which the Licensee is the 
   # primary author or distributor, and which performs substantial 
   # additional tasks beyond the translation of (La)TeX into HTML.
   # The C source of the Code may not be distributed by the Licensee
   # to any other parties under any circumstances.
   #
 # last modified 06/26/00 by Alexander Sakharuk  # last modified 06/26/00 by Alexander Sakharuk
 # 11/6 Gerd Kortemeyer  # 11/6 Gerd Kortemeyer
 # 6/1/1 Gerd Kortemeyer  # 6/1/1 Gerd Kortemeyer
   # 2/21,3/13 Guy
   # 3/29,5/4 Gerd Kortemeyer
   # 5/10 Scott Harrison
   # 5/26 Gerd Kortemeyer
   # 5/27 H. K. Ng
   # 6/2,6/3,6/8,6/9 Gerd Kortemeyer
   # 6/12,6/13 H. K. Ng
   # 6/16 Gerd Kortemeyer
   # 7/27 H. K. Ng
   # 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
   # Guy Albertelli
   # 9/26 Gerd Kortemeyer
   # Dec Guy Albertelli
   # YEAR=2002
   # 1/1 Gerd Kortemeyer
   # 1/2 Matthew Hall
   # 1/3 Gerd Kortemeyer
   #
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd $outputstack $redirection $textredirection $on_offimport @extlinks);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode $errorcount $warningcount);
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::LCParser();
 use Safe;  use HTML::TreeBuilder();
 use Safe::Hole;  use HTML::Entities();
 use Opcode;  use Safe();
 use Apache::Constants qw(:common);  use Safe::Hole();
   use Math::Cephes();
   use Math::Random();
   use Opcode();
   
 sub register {  sub register {
   my $space;    my ($space,@taglist) = @_;
   my @taglist;    foreach my $temptag (@taglist) {
   my $temptag;      push(@{ $Apache::lonxml::alltags{$temptag} },$space);
   ($space,@taglist) = @_;  
   foreach $temptag (@taglist) {  
     $Apache::lonxml::alltags{$temptag}=$space;  
   }    }
 }  }
   
 sub printalltags {  sub deregister {
   my $temp;    my ($space,@taglist) = @_;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach my $temptag (@taglist) {
     &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");      my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
       if ($tempspace eq $space) {
         pop(@{ $Apache::lonxml::alltags{$temptag} });
       }
   }    }
     #&printalltags();
 }  }
 use Apache::style;  
 use Apache::lontexconvert;  use Apache::Constants qw(:common);
 use Apache::run;  use Apache::lontexconvert();
 use Apache::londefdef;  use Apache::style();
 use Apache::scripttag;  use Apache::run();
   use Apache::londefdef();
   use Apache::scripttag();
   use Apache::edit();
   use Apache::lonnet();
   use Apache::File();
   use Apache::loncommon();
   use Apache::lonfeedback();
   use Apache::lonmsg();
   use Apache::loncacc();
   
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
   #debugging control, to turn on debugging modify the correct handler
   $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
 @pwd=();  @pwd=();
 $outputstack = '';  
 $redirection = 1;  #these two are used for capturing a subset of the output for later processing,
 $textredirection = 1;  #don't touch them directly use &startredirection and &endredirection
 $on_offimport = 0;  @outputstack = ();
   $redirection = 0;
   
   #controls wheter the <import> tag actually does
   $import = 1;
 @extlinks=();  @extlinks=();
   
   # meta mode is a bit weird only some output is to be turned off
   #<output> tag turns metamode off (defined in londefdef.pm)
   $metamode = 0;
   
   # turns on and of run::evaluate actually derefencing var refs
   $evaluate = 1;
   
   # data structure for eidt mode, determines what tags can go into what other tags
   %insertlist=();
   
   # stores the list of active tag namespaces
   @namespace=();
   
   # if 0 all high ASCII characters will be encoded into HTML Entities
   $prevent_entity_encode=0;
   
   # has the dynamic menu been updated to know about this resource
   $Apache::lonxml::registered=0;
   
   # a pointer the the Apache request object
   $Apache::lonxml::request='';
   
   # a problem number counter, and check on ether it is used
   $Apache::lonxml::counter=1;
   $Apache::lonxml::counter_changed=0;
   
   #internal check on whether to look at style defs
   $Apache::lonxml::usestyle=1;
   
   sub xmlbegin {
     my $output='';
     if ($ENV{'browser.mathml'}) {
         $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 {
       my ($discussiononly,$symb)=@_;
       my $discussion='';
       if ($ENV{'request.course.id'}) {
          my $crs='/'.$ENV{'request.course.id'};
          if ($ENV{'request.course.sec'}) {
             $crs.='_'.$ENV{'request.course.sec'};
          }                 
          $crs=~s/\_/\//g;
          my $seeid=&Apache::lonnet::allowed('rin',$crs);
          unless ($symb) {
              $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'}) {
                 unless ($discussiononly) {
                    $discussion.=
                     '<address><hr />';
        }
                 my $idx;
                 for ($idx=1;$idx<=$contrib{'version'};$idx++) {
    my $hidden=($contrib{'hidden'}=~/\.$idx\./);
    my $deleted=($contrib{'deleted'}=~/\.$idx\./);
    unless ((($hidden) && (!$seeid)) || ($deleted)) {
                    my $message=$contrib{$idx.':message'};
                    $message=~s/\n/\<br \/\>/g;
    $message=&Apache::lontexconvert::msgtexconverted($message);
                    if ($message) {
                     if ($hidden) {
         $message='<font color="#888888">'.$message.'</font>';
                     }
                     my $screenname=&Apache::loncommon::screenname(
                                  $contrib{$idx.':sendername'},
          $contrib{$idx.':senderdomain'});
                     my $plainname=&Apache::loncommon::nickname(
                                  $contrib{$idx.':sendername'},
          $contrib{$idx.':senderdomain'});
   
                     my $sender='Anonymous';
                     if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
                         $sender=&Apache::loncommon::aboutmewrapper(
                                  $plainname,
                                  $contrib{$idx.':sendername'},
                                  $contrib{$idx.':senderdomain'}).' ('.
                                 $contrib{$idx.':sendername'}.' at '.
         $contrib{$idx.':senderdomain'}.')';
                         if ($contrib{$idx.':anonymous'}) {
     $sender.=' [anonymous] '.
                                        $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>';
     }                     
                             $sender.=' <a href="/adm/feedback?deldisc='.
    $symb.':::'.$idx.'">Delete</a>';
                         }
                     } else {
                         if ($screenname) {
     $sender='<i>'.$screenname.'</i>';
                         }
                     }
     $discussion.='<p><b>'.$sender.'</b> ('.
                         localtime($contrib{$idx.':timestamp'}).
                         '):<blockquote>'.$message.
                         '</blockquote></p>';
           }
                  } 
                 }
                 unless ($discussiononly) {
                    $discussion.='</address>';
         }
             }
             if ($discussiononly) {
         $discussion.=(<<ENDDISCUSS);
   <form action="/adm/feedback" method="post" name="mailform">
   <input type="submit" name="discuss" value="Post Discussion" />
   <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
   <input type="hidden" name="symb" value="$symb" />
   <input type="hidden" name="sendit" value="true" />
   <br />
   <font size="1">Note: in anonymous discussion, your name is visible only to
   course faculty</font><br />
   <textarea name=comment cols=60 rows=10 wrap=hard></textarea>
   </form>
   ENDDISCUSS
                $discussion.=&Apache::lonfeedback::generate_preview_button();
             }
          }
       }
       return $discussion.($discussiononly?'':'</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 {
       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.png?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() {
       my $headerstring='';
       if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
            $headerstring.=
                '<meta Content-Type="text/html; charset=x-mac-roman">';
       }
       return $headerstring;
   }
   
   
   ##
   ## switchmenu - modeled on lonmenu::switchmenu, but better. 
   ## Helper function for registerurl
   ##
   sub switchmenu {
       my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
       return(<<ENDSMENU);
       menu.switchbutton($row,$col,'$imgsrc','$texttop','$textbot','$action','$description');
   ENDSMENU
   }
   
   sub registerurl {
       my $forcereg=shift;
       my $target = shift;
       my $result = '';
       
       if ($target eq 'edit') {
           $result .="<script>\n".
               "if (typeof menu != 'undefined') {menu.currentURL=null;}\n".
               &Apache::loncommon::browser_and_searcher_javascript().
                   "\n</script>\n";
       }
       if ((($ENV{'request.publicaccess'}) || 
            (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
           (!$forcereg)) {
    return $result.
            '<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 $newmail='';
       if (&Apache::lonmsg::newmail()) { 
          $newmail='menu.setstatus("you have","messages");';
       }
       my $timesync='menu.syncclock(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")',
                        'View user submissions for this assessment resource');
   ENDSUBM
               }
       if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
    $hwkadd.=(<<ENDGRDS);
                        menu.switchbutton(7,2,'pgrd.gif','problem','grades','gocmd("/adm/grades","gradingmenu")',
                        'Modify user grades for this assessment resource');
   ENDGRDS
               }
       if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
    $hwkadd.=(<<ENDPARM);
                        menu.switchbutton(7,3,'pparm.gif','problem','parms','gocmd("/adm/parmset","set")',
                        'Modify deadlines, etc, for this assessment resource');
   ENDPARM
               }
    }
           ###
           ### Determine whether or not to display the 'cstr' button for this
           ### resource
           ###
           my $editbutton = '';
           if ($ENV{'user.author'}) {
               if ($ENV{'request.role'}=~/^(ca|au)/) {
                   # Set defaults for authors
                   my ($top,$bottom) = ('con-','struct');
                   my $action = "go('/priv/".$ENV{'user.name'}."');";
                   my $cadom  = $ENV{'request.role.domain'};
                   my $caname = $ENV{'user.name'};
                   my $desc = "Enter my resource construction space";
                   # Set defaults for co-authors
                   if ($ENV{'request.role'} =~ /^ca/) { 
                       ($cadom,$caname)=($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
                       ($top,$bottom) = ('co con-','struct');
                       $action = 'go("/priv/'.$caname.'");';
                       $desc = "Enter construction space as co-author";
                   }
                   # Check that we are on the correct machine
                   my $home = &Apache::lonnet::homeserver($caname,$cadom);
                   if ($home eq $Apache::lonnet::perlvar{'lonHostID'}) {
                       $editbutton=&switchmenu
                           (6,1,$top,,$bottom,$action,$desc);
                   }
               }
               ##
               ## Determine if user can edit url.
               ##
               my $cfile='';
               my $cfuname='';
               my $cfudom='';
               if ($ENV{'request.filename'}) {
                   my $file=&Apache::lonnet::declutter($ENV{'request.filename'});
                   $file=~s/^(\w+)\/(\w+)/\/priv\/$2/;
                   # Chech that the user has permission to edit this resource
                   ($cfuname,$cfudom)=&Apache::loncacc::constructaccess($file,$1);
                   if (defined($cfudom)) {
                       if (&Apache::lonnet::homeserver($cfuname,$cfudom) 
                           eq $Apache::lonnet::perlvar{'lonHostID'}) {
                           $cfile=$file;
                       }
                   }
               }        
               # Finally, turn the button on or off
               if ($cfile) {
                   $editbutton=&switchmenu
                       (6,1,'cstr.gif','edit','resource',
                        'go("'.$cfile.'");',"Edit this resource");
               } elsif ($editbutton eq '') {
                   $editbutton = '    menu.clearbut(6,1);';
               }
           }
           ###
           ###
    $result = (<<ENDREGTHIS);
        
   <script language="JavaScript">
   // BEGIN LON-CAPA Internal
   
       function LONCAPAreg() {
     menu=window.open("$nothing","LONCAPAmenu","",false);
             menu.clearTimeout(menu.menucltim);
             $timesync
             $newmail
     menu.currentURL=window.location.pathname;
             menu.reloadURL=window.location.pathname;
             menu.currentSymb="$ENV{'request.symb'}";
             menu.reloadSymb="$ENV{'request.symb'}";
             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)','Provide my evaluation of this resource');
             menu.switchbutton
       (8,2,'fdbk.gif','feedback','discuss','gopost("/adm/feedback",currentURL)','Provide feedback messages or contribute to the course discussion about this resource');
             menu.switchbutton
        (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)','Prepare a printable document');
             menu.switchbutton
          (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)','Go to the previous resource in the course sequence');
             menu.switchbutton
        (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)','Go to the next resource in the course sequence');
             menu.switchbutton
                               (9,1,'sbkm.gif','set','bookmark','set_bookmark()','Set a bookmark for this resource');
             menu.switchbutton
                            (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()','Use or edit my bookmark collection');
             menu.switchbutton
                                  (9,3,'anot.gif','anno-','tations','annotate()','Make notes and annotations about this resource');
             $hwkadd
             $editbutton
       }
   
       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)','Return to the last known location in the course sequence');
     }
             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);clearbut(6,1)',
     2000);
   
         }
   
   // END LON-CAPA Internal
   </script>
   ENDREGTHIS
   
       } else {
           $result = (<<ENDDONOTREGTHIS);
   
   <script language="JavaScript">
   // BEGIN LON-CAPA Internal
   
       function LONCAPAreg() {
     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() {
       }
   
   // END LON-CAPA Internal
   </script>
   ENDDONOTREGTHIS
       }
       return $result;
   }
   
   sub loadevents() {
       return 'LONCAPAreg();';
   }
   
   sub unloadevents() {
       return 'LONCAPAstale();';
   }
   
   sub printalltags {
     my $temp;
     foreach $temp (sort keys %Apache::lonxml::alltags) {
       &Apache::lonxml::debug("$temp -- ".
     join(',',@{ $Apache::lonxml::alltags{$temp} }));
     }
   }
   
 sub xmlparse {  sub xmlparse {
    my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
   
  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;   &setup_globals($request,$target);
  if ($target eq 'meta') {  #
    $Apache::lonxml::textredirection = 0;  # do we have a course style file?
    $Apache::lonxml::on_offimport = 1;  #
  } elsif ($target eq 'grade') {  
    $Apache::lonxml::textredirection = 0;   if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') {
    $Apache::lonxml::on_offimport = 0;       my $bodytext=
  } else {   $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
    $Apache::lonxml::textredirection = 1;       if ($bodytext) {
    $Apache::lonxml::on_offimport = 0;         my $location=&Apache::lonnet::filelocation('',$bodytext);
          my $styletext=&Apache::lonnet::getfile($location);
          if ($styletext ne '-1') {
             %style_for_target = (%style_for_target,
                             &Apache::style::styleparser($target,$styletext));
          }
       }
  }   }
   
  #&printalltags();   #&printalltags();
  my @pars = ();   my @pars = ();
  @Apache::lonxml::pwd=();  
  my $pwd=$ENV{'request.filename'};   my $pwd=$ENV{'request.filename'};
  $pwd =~ s:/[^/]*$::;   $pwd =~ s:/[^/]*$::;
  &newparser(\@pars,\$content_file_string,$pwd);   &newparser(\@pars,\$content_file_string,$pwd);
  my $currentstring = '';  
  my $finaloutput = '';   
  my $newarg = '';  
  my $result;  
   
  my $safeeval = new Safe;   my $safeeval = new Safe;
  my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
  $safeeval->permit("entereval");   &init_safespace($target,$safeeval,$safehole,$safeinit);
  $safeeval->permit(":base_math");  
  $safeeval->deny(":base_io");  
  $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');  
 #need to inspect this class of ops  
 # $safeeval->deny(":base_orig");  
  $safeinit .= ';$external::target='.$target.';';  
  $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';  
  &Apache::run::run($safeinit,$safeeval);  
 #-------------------- Redefinition of the target in the case of compound target  #-------------------- Redefinition of the target in the case of compound target
   
  ($target, my @tenta) = split('&&',$target);   ($target, my @tenta) = split('&&',$target);
   
  my @stack = ();    my @stack = ();
  my @parstack = ();   my @parstack = ();
  &initdepth;   &initdepth;
  my $token;  
  while ( $#pars > -1 ) {  
    while ($token = $pars[$#pars]->get_token) {  
      if ($token->[0] eq 'T') {  
        if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}  
        # $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');  
      } elsif ($token->[0] eq 'S') {  
        # if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}  
        # add tag to stack      
        push (@stack,$token->[1]);  
        # add parameters list to another stack  
        push (@parstack,&parstring($token));  
        &increasedepth($token);         
        if (exists $style_for_target{$token->[1]}) {  
     
  if ($Apache::lonxml::redirection == 1) {  
    $finaloutput .= &recurse($style_for_target{$token->[1]},  
     $target,$safeeval,\%style_for_target,  
     @parstack);  
  } else {  
    $Apache::lonxml::outputstack .=  &recurse($style_for_target{$token->[1]},  
  $target,$safeeval,\%style_for_target,  
  @parstack);  
  }  
     
        } else {  
  $result = &callsub("start_$token->[1]", $target, $token,\@parstack,  
     \@pars, $safeeval, \%style_for_target);  
        }                
      } elsif ($token->[0] eq 'E')  {  
        #if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}  
        #clear out any tags that didn't end  
        while ($token->[1] ne $stack[$#stack]   
       && ($#stack > -1)) {  
  &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");     
  pop @stack;pop @parstack;&decreasedepth($token);  
        }  
          
        if (exists $style_for_target{'/'."$token->[1]"}) {  
   
  if ($Apache::lonxml::redirection == 1) {   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
  $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},     $safeeval,\%style_for_target);
   $target,$safeeval,\%style_for_target,   if ($ENV{'request.uri'}) {
   @parstack);      &writeallows($ENV{'request.uri'});
         } else {   }
          $Apache::lonxml::outputstack .=  &recurse($style_for_target{'/'."$token->[1]"},   if ($Apache::lonxml::counter_changed) { &store_counter() }
   $target,$safeeval,\%style_for_target,   return $finaloutput;
   @parstack);  }
         }  
   
        } else {  sub htmlclean {
  $result = &callsub("end_$token->[1]", $target, $token, \@parstack,      my ($raw,$full)=@_;
        \@pars,$safeeval, \%style_for_target);  
        }  
      }  
      if ($result ne "") {  
        if ( $#parstack > -1 ) {  
    
  if ($Apache::lonxml::redirection == 1) {  
  $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
  $parstack[$#parstack]);  
         } else {  
          $Apache::lonxml::outputstack .= &Apache::run::evaluate($result,$safeeval,  
  $parstack[$#parstack]);  
         }  
   
        } else {      my $tree = HTML::TreeBuilder->new;
  $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');      $tree->ignore_unknown(0);
        }  
        $result = '';  
      } else {  
          $finaloutput .= $result;  
      }  
      if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}  
    }  
    pop @pars;  
    pop @Apache::lonxml::pwd;  
  }  
   
  return $finaloutput;      $tree->parse($raw);
   
       my $output= $tree->as_HTML(undef,' ');
   
       $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis;
       $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
       unless ($full) {
          $output=~s/\<[\/]*(body|head|html)\>//gis;
       }
   
       $tree = $tree->delete;
   
       return $output;
 }  }
   
 sub recurse {  sub latex_special_symbols {
         my ($current_token,$stack,$parstack)=@_;
   my @innerstack = ();       $current_token=~s/\\ /\\char92 /g;
   my @innerparstack = ();      $current_token=~s/\^/\\char94 /g;
   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;      $current_token=~s/\~/\\char126 /g;
   my @pat = ();      $current_token=~s/(&[^a-z\#])/\\$1/g;
   &newparser(\@pat,\$newarg);      $current_token=~s/([^&])\#/$1\\#/g;
   my $tokenpat;      $current_token=~s/(\$|_|{|})/\\$1/g;
   my $partstring = '';      $current_token=~s/\\char92 /\\texttt{\\char92}/g;
   my $output='';      $current_token=~s/>/\$>\$/g; #more
   my $decls='';      $current_token=~s/</\$<\$/g; #less
   while ( $#pat > -1 ) {      if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit
     while  ($tokenpat = $pat[$#pat]->get_token) {      if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space
       if ($tokenpat->[0] eq 'T') {      return $current_token;
   if ($Apache::lonxml::textredirection == 1) {$partstring = $tokenpat->[1];}  }
       } elsif ($tokenpat->[0] eq 'S') {  
  push (@innerstack,$tokenpat->[1]);  sub inner_xmlparse {
  push (@innerparstack,&parstring($tokenpat));    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
  &increasedepth($tokenpat);    my $finaloutput = '';
  $partstring = &callsub("start_$tokenpat->[1]",     my $result;
        $target, $tokenpat, \@innerparstack,    my $token;
        \@pat, $safeeval, $style_for_target);    while ( $#$pars > -1 ) {
       } elsif ($tokenpat->[0] eq 'E') {      while ($token = $$pars['-1']->get_token) {
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
    if ($metamode<1) {
       my $text=$token->[1];
       if ($token->[0] eq 'C' && $target eq 'tex') {
    $text = '%'.$text."\n";
       }
       $result.=$text;
    }
         } elsif ($token->[0] eq 'PI') {
    if ($metamode<1) {
     $result=$token->[2];
    }
         } elsif ($token->[0] eq 'S') {
    # add tag to stack
    push (@$stack,$token->[1]);
    # add parameters list to another stack
    push (@$parstack,&parstring($token));
    &increasedepth($token);
    if ($Apache::lonxml::usestyle &&
       exists($$style_for_target{$token->[1]})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
       &Apache::lonxml::newparser($pars,\$string);
    } else {
     $result = &callsub("start_$token->[1]", $target, $token, $stack,
        $parstack, $pars, $safeeval, $style_for_target);
    }
         } elsif ($token->[0] eq 'E') {
  #clear out any tags that didn't end   #clear out any tags that didn't end
  while ($tokenpat->[1] ne $innerstack[$#innerstack]    while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
        && ($#innerstack > -1)) {    my $lasttag=$$stack[-1];
   &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");    if ($token->[1] =~ /^$lasttag$/i) {
   pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);      &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; as end tag to &lt;'.$$stack[-1].'&gt;');
  }      last;
  $partstring = &callsub("end_$tokenpat->[1]",  
        $target, $tokenpat, \@innerparstack,  
        \@pat, $safeeval, $style_for_target);  
       }  
       #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 {    } else {
     $decls= $parstack[$#parstack];      &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; when looking for &lt;/'.$$stack[-1].'&gt; in file');
       &end_tag($stack,$parstack,$token);
   }    }
    }
   
    if ($Apache::lonxml::usestyle &&
       exists($$style_for_target{'/'."$token->[1]"})) {
       $Apache::lonxml::usestyle=0;
       my $string=$$style_for_target{'/'.$token->[1]}.
         '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
       &Apache::lonxml::newparser($pars,\$string);
  } else {   } else {
   if ( $#innerparstack > -1 ) {     $result = &callsub("end_$token->[1]", $target, $token, $stack,
     $decls=$innerparstack[$#innerparstack];       $parstack, $pars,$safeeval, $style_for_target);
   } else {   }
     $decls='';        } else {
   }   &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
         }
         #evaluate variable refs in result
         if ($result ne "") {
    if ( $#$parstack > -1 ) {
     $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);
    } else {
     $result= &Apache::run::evaluate($result,$safeeval,'');
    }
         }
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
    if ($target eq 'tex') {
       $result=&latex_special_symbols($result,$stack,$parstack);
  }   }
  $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);  
  $partstring = '';  
       }        }
       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;  
  &decreasedepth($tokenpat);}        # Encode any high ASCII characters
         if (!$Apache::lonxml::prevent_entity_encode) {
    $result=&HTML::Entities::encode($result,"\200-\377");
         }
         if ($Apache::lonxml::redirection) {
    $Apache::lonxml::outputstack['-1'] .= $result;
         } else {
    $finaloutput.=$result;
         }
         $result = '';
   
         if ($token->[0] eq 'E') { 
    &end_tag($stack,$parstack,$token);
         }
       }
       if ($#$pars > -1) {
    pop @$pars;
    pop @Apache::lonxml::pwd;
     }      }
     pop @pat;  
     pop @Apache::lonxml::pwd;  
   }    }
   return $output;  
     # if ($target eq 'meta') {
     #   $finaloutput.=&endredirection;
     # }
   
   
     if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
       $finaloutput=&afterburn($finaloutput);
     }    
     return $finaloutput;
 }  }
   
 sub callsub {  sub callsub {
   my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;    my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $currentstring='';    my $currentstring='';
     my $nodefault;
   {    {
       my $sub1;      my $sub1;
     no strict 'refs';      no strict 'refs';
     if (my $space=$Apache::lonxml::alltags{$token->[1]}) {      my $tag=$token->[1];
       #&Apache::lonxml::debug("Calling sub $sub in $space<br>\n");      my $space=$Apache::lonxml::alltags{$tag}[-1];
       $sub1="$space\:\:$sub";      if (!$space) {
       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);        $tag=~tr/A-Z/a-z/;
       $currentstring = &$sub1($target,$token,$parstack,$parser,   $sub=~tr/A-Z/a-z/;
      $safeeval,$style);   $space=$Apache::lonxml::alltags{$tag}[-1]
     } else {      }
       #&Apache::lonxml::debug("NOT Calling sub $sub in $space<br>\n");  
       if (defined($token->[4])) {      my $deleted=0;
  $currentstring = $token->[4];      $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
       if (($token->[0] eq 'S') && ($target eq 'modified')) {
         $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
        $parstack,$parser,$safeeval,
        $style);
       }
       if (!$deleted) {
         if ($space) {
    #&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
    $sub1="$space\:\:$sub";
    ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
        $parstack,$parser,$safeeval,
        $style);
       } else {        } else {
  $currentstring = $token->[2];   #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
    if ($metamode <1) {
     if (defined($token->[4]) && ($metamode < 1)) {
       $currentstring = $token->[4];
     } else {
       $currentstring = $token->[2];
     }
    }
         }
         #    &Apache::lonxml::debug("nodefalt:$nodefault:");
         if ($currentstring eq '' && $nodefault eq '') {
    if ($target eq 'edit') {
     #&Apache::lonxml::debug("doing default edit for $token->[1]");
     if ($token->[0] eq 'S') {
       $currentstring = &Apache::edit::tag_start($target,$token);
     } elsif ($token->[0] eq 'E') {
       $currentstring = &Apache::edit::tag_end($target,$token);
     }
    } elsif ($target eq 'modified') {
     if ($token->[0] eq 'S') {
       $currentstring = $token->[4];
       $currentstring.=&Apache::edit::handle_insert();
     } elsif ($token->[0] eq 'E') {
       $currentstring = $token->[2];
               $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
     } else {
       $currentstring = $token->[2];
     }
    }
       }        }
     }      }
     use strict 'refs';      use strict 'refs';
Line 254  sub callsub { Line 858  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   sub setup_globals {
     my ($request,$target)=@_;
     $Apache::lonxml::request=$request;
     $Apache::lonxml::registered = 0;
     $errorcount=0;
     $warningcount=0;
     $Apache::lonxml::default_homework_loaded=0;
     $Apache::lonxml::usestyle=1;
     &init_counter();
     @Apache::lonxml::pwd=();
     @Apache::lonxml::extlinks=();
     if ($target eq 'meta') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'answer') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'grade') {
       &startredirection;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } elsif ($target eq 'modified') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 0;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'edit') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 0;
       $Apache::lonxml::import = 0;
     } elsif ($target eq 'analyze') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     } else {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 0;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 1;
     }
   }
   
   sub init_safespace {
     my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->permit("entereval");
     $safeeval->permit(":base_math");
     $safeeval->permit("sort");
     $safeeval->deny(":base_io");
     $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
     
     $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
     $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
     $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
     $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh');
     $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh');
     $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh');
     $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh');
     $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh');
     $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh');
     $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf');
     $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc');
     $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0');
     $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1');
     $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn');
     $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv');
     $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0');
     $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
     $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
     $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
     
     $safehole->wrap(\&Math::Cephes::bdtr  ,$safeeval,'&bdtr'  );
     $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' );
     $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' );
     $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' );
     $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' );
     $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc');
     $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri');
     $safehole->wrap(\&Math::Cephes::fdtr  ,$safeeval,'&fdtr'  );
     $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' );
     $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' );
     $safehole->wrap(\&Math::Cephes::gdtr  ,$safeeval,'&gdtr'  );
     $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' );
     $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' );
     $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc');
     $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri');
     $safehole->wrap(\&Math::Cephes::ndtr  ,$safeeval,'&ndtr'  );
     $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' );
     $safehole->wrap(\&Math::Cephes::pdtr  ,$safeeval,'&pdtr'  );
     $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' );
     $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' );
     $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
     $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');
   
   #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
   #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
   #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
   #  $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul');
   #  $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv');
   #  $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid');
   
     $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
     $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');
     $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');
     $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f');
     $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma');
     $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal');
     $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial');
     $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square');
     $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');
     $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');
     $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');
     $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');
     $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');
     $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');
     $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');
     $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial');
     $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial');
     $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_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_set_seed,$safeeval,'&random_set_seed');
   
   #need to inspect this class of ops
   # $safeeval->deny(":base_orig");
     $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);
   }
   
   sub default_homework_load {
       my ($safeeval)=@_;
       &Apache::lonxml::debug('Loading default_homework');
       my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
       if ($default == -1) {
    &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
       } else {
    &Apache::run::run($default,$safeeval);
    $Apache::lonxml::default_homework_loaded=1;
       }
   }
   
   sub startredirection {
     $Apache::lonxml::redirection++;
     push (@Apache::lonxml::outputstack, '');
   }
   
   sub endredirection {
     if (!$Apache::lonxml::redirection) {
       &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
       return '';
     }
     $Apache::lonxml::redirection--;
     pop @Apache::lonxml::outputstack;
   }
   
   sub end_tag {
     my ($tagstack,$parstack,$token)=@_;
     pop(@$tagstack);
     pop(@$parstack);
     &decreasedepth($token);
   }
   
 sub initdepth {  sub initdepth {
   @Apache::lonxml::depthcounter=();    @Apache::lonxml::depthcounter=();
   $Apache::lonxml::depth=-1;    $Apache::lonxml::depth=-1;
Line 269  sub increasedepth { Line 1046  sub increasedepth {
   }    }
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");    &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
 #print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";  #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
 }  }
   
 sub decreasedepth {  sub decreasedepth {
Line 280  sub decreasedepth { Line 1057  sub decreasedepth {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;      $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
   }    }
   if (  $Apache::lonxml::depth < -1) {    if (  $Apache::lonxml::depth < -1) {
     &Apache::lonxml::warning("Unbalanced tags in resource");         &Apache::lonxml::warning("Missing tags, unable to properly run file.");
     $Apache::lonxml::depth='-1';      $Apache::lonxml::depth='-1';
   }    }
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");    &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
 #print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";  #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
 }  }
   
 sub get_all_text {  sub get_all_text_unbalanced {
   #there is a copy of this in lonpublisher.pm
  my($tag,$pars)= @_;   my($tag,$pars)= @_;
  my $depth=0;  
  my $token;   my $token;
  my $result='';   my $result='';
  my $tag=substr($tag,1); #strip the / off the tag   $tag='<'.$tag.'>';
  #&Apache::lonxml::debug("have:$tag:");   while ($token = $$pars[-1]->get_token) {
  while (($depth >=0) && ($token = $pars->get_token)) {     if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
    #&Apache::lonxml::debug("token:$token->[0]:$depth:$token->[1]");  
    if ($token->[0] eq 'T') {  
      $result.=$token->[1];       $result.=$token->[1];
      } elsif ($token->[0] eq 'PI') {
        $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {     } elsif ($token->[0] eq 'S') {
      if ($token->[1] eq $tag) { $depth++; }  
      $result.=$token->[4];       $result.=$token->[4];
    } elsif ($token->[0] eq 'E')  {     } elsif ($token->[0] eq 'E')  {
      if ( $token->[1] eq $tag) { $depth--; }       $result.=$token->[2];
      #skip sending back the last end tag     }
      if ($depth > -1) { $result.=$token->[2]; } else {     if ($result =~ /(.*)\Q$tag\E(.*)/s) {
        $pars->unget_token($token);       &Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
        &Apache::lonxml::debug('Result is :'.$1);
        $result=$1;
        my $redo=$tag.$2;
        &Apache::lonxml::newparser($pars,\$redo);
        last;
      }
    }
    return $result
   }
   
   sub increment_counter {
       $Apache::lonxml::counter++;
       $Apache::lonxml::counter_changed=1;
   }
   
   sub init_counter {
       if (defined($ENV{'form.counter'})) {
    $Apache::lonxml::counter=$ENV{'form.counter'};
       } elsif (not defined($Apache::lonxml::counter)) {
    $Apache::lonxml::counter=1;
    &store_counter();
       }
       $Apache::lonxml::counter_changed=0;
   }
   
   sub store_counter {
       &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
       return '';
   }
   
   sub get_all_text {
    my($tag,$pars)= @_;
    &Apache::lonxml::debug("Got a ".ref($pars));
    if (ref($pars) ne 'ARRAY') {
        $pars=[$pars];
    }
    my $depth=0;
    my $token;
    my $result='';
    if ( $tag =~ m:^/: ) { 
      my $tag=substr($tag,1); 
      #&Apache::lonxml::debug("have:$tag:");
      while (($depth >=0) && ($#$pars > -1)) {
        while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
          #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
          if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
    $result.=$token->[1];
          } elsif ($token->[0] eq 'PI') {
    $result.=$token->[2];
          } elsif ($token->[0] eq 'S') {
    if ($token->[1] =~ /^$tag$/i) { $depth++; }
    $result.=$token->[4];
          } elsif ($token->[0] eq 'E')  {
    if ( $token->[1] =~ /^$tag$/i) { $depth--; }
    #skip sending back the last end tag
    if ($depth > -1) { $result.=$token->[2]; } else {
      $$pars[-1]->unget_token($token);
    }
          }
        }
        if (($depth >=0) && ($#$pars > 0) ) {
          pop(@$pars);
          pop(@Apache::lonxml::pwd);
      }       }
    }     }
    } else {
        while ($#$pars > -1) {
    while ($token = $$pars[-1]->get_token) {
        #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
        if (($token->[0] eq 'T')||($token->[0] eq 'C')||
    ($token->[0] eq 'D')) {
    $result.=$token->[1];
        } elsif ($token->[0] eq 'PI') {
    $result.=$token->[2];
        } elsif ($token->[0] eq 'S') {
    if ( $token->[1] =~ /^$tag$/i) {
        $$pars[-1]->unget_token($token); last;
    } else {
        $result.=$token->[4];
    }
        } elsif ($token->[0] eq 'E')  {
    $result.=$token->[2];
        }
    }
    if (($#$pars > 0) ) {
        pop(@$pars);
        pop(@Apache::lonxml::pwd);
    } else { last; }
        }
  }   }
 # &Apache::lonxml::debug("Exit:$result:");   if ($result =~ m|<LONCAPA_INTERNAL_TURN_STYLE_ON />|) {
        $Apache::lonxml::usestyle=1;
    }
    #&Apache::lonxml::debug("Exit:$result:");
  return $result   return $result
 }  }
   
 sub newparser {  sub newparser {
   my ($parser,$contentref,$dir) = @_;    my ($parser,$contentref,$dir) = @_;
   push (@$parser,HTML::TokeParser->new($contentref));    push (@$parser,HTML::LCParser->new($contentref));
     $$parser['-1']->xml_mode('1');
   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 {
Line 330  sub newparser { Line 1196  sub newparser {
 sub parstring {  sub parstring {
   my ($token) = @_;    my ($token) = @_;
   my $temp='';    my $temp='';
   map {    foreach (@{$token->[3]}) {
     unless ($_=~/\W/) {      unless ($_=~/\W/) {
       my $val=$token->[2]->{$_};        my $val=$token->[2]->{$_};
       $val =~ s/([\%\@\\])/\$1/;        $val =~ s/([\%\@\\\"])/\\$1/g;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }        #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";"        $temp .= "my \$$_=\"$val\";"
     }      }
   } @{$token->[3]};    }
   return $temp;    return $temp;
 }  }
   
 sub writeallows {  sub writeallows {
       unless ($#extlinks>=0) { return; }
     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);      my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
       if ($ENV{'httpref.'.$thisurl}) {
    $thisurl=$ENV{'httpref.'.$thisurl};
       }
     my $thisdir=$thisurl;      my $thisdir=$thisurl;
     $thisdir=~s/\/[^\/]+$//;      $thisdir=~s/\/[^\/]+$//;
     my %httpref=();      my %httpref=();
     map {      foreach (@extlinks) {
        $httpref{'httpref.'.         $httpref{'httpref.'.
          &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;           &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
       }
       @extlinks=();
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
 }  }
   
   #
   # Afterburner handles anchors, highlights and links
   #
   sub afterburn {
       my $result=shift;
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
       ['highlight','anchor','link']);
       if ($ENV{'form.highlight'}) {
          foreach (split(/\,/,$ENV{'form.highlight'})) {
              my $anchorname=$_;
      my $matchthis=$anchorname;
              $matchthis=~s/\_+/\\s\+/g;
              $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
          }
       }
       if ($ENV{'form.link'}) {
          foreach (split(/\,/,$ENV{'form.link'})) {
              my ($anchorname,$linkurl)=split(/\>/,$_);
      my $matchthis=$anchorname;
              $matchthis=~s/\_+/\\s\+/g;
              $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
          }
       }
       if ($ENV{'form.anchor'}) {
           my $anchorname=$ENV{'form.anchor'};
    my $matchthis=$anchorname;
           $matchthis=~s/\_+/\\s\+/g;
           $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
           $result.=(<<"ENDSCRIPT");
   <script>
       document.location.hash='$anchorname';
   </script>
   ENDSCRIPT
       }
       return $result;
   }
   
   sub storefile {
       my ($file,$contents)=@_;
       if (my $fh=Apache::File->new('>'.$file)) {
    print $fh $contents;
           $fh->close();
       } else {
         &warning("Unable to save file $file");
       }
   }
   
   sub createnewhtml {
     my $filecontents=(<<SIMPLECONTENT);
   <html>
   <head>
   <title>
                              Title of Document Goes Here
   </title>
   </head>
   <body bgcolor="#FFFFFF">
   
                              Body of Document Goes Here
   
   </body>
   </html>
   SIMPLECONTENT
     return $filecontents;
   }
   
   
   sub inserteditinfo {
         my ($result,$filecontents)=@_;
         $filecontents = &HTML::Entities::encode($filecontents);
   #      my $editheader='<a href="#editsection">Edit below</a><hr />';
         my $buttons=(<<BUTTONS);
   <input type="submit" name="attemptclean" 
          value="Save and then attempt to clean HTML" />
   <input type="submit" name="savethisfile" value="Save this" />
   <input type="submit" name="viewmode" value="View" />
   BUTTONS
         my $editfooter=(<<ENDFOOTER);
   <hr />
   <a name="editsection" />
   <form method="post">
   <input type="hidden" name="editmode" value="Edit" />
   $buttons<br />
   <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
   <br />$buttons
   <br />
   </form>
   ENDFOOTER
   #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
         $result=~s/(\<\/body\>)/$editfooter/is;
         return $result;
   }
   
   sub get_target {
     my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
     if ( $ENV{'request.state'} eq 'published') {
       if ( defined($ENV{'form.grade_target'})
    && ($viewgrades == 'F' )) {
         return ($ENV{'form.grade_target'});
       } elsif (defined($ENV{'form.grade_target'})) {
         if (($ENV{'form.grade_target'} eq 'web') ||
     ($ENV{'form.grade_target'} eq 'tex') ) {
    return $ENV{'form.grade_target'}
         } else {
    return 'web';
         }
       } else {
         return 'web';
       }
     } elsif ($ENV{'request.state'} eq 'construct') {
       if ( defined($ENV{'form.grade_target'})) {
         return ($ENV{'form.grade_target'});
       } else {
         return 'web';
       }
     } else {
       return 'web';
     }
   }
   
 sub handler {  sub handler {
   my $request=shift;    my $request=shift;
     
   my $target='web';    my $target=&get_target();
   
   $Apache::lonxml::debug=0;    $Apache::lonxml::debug=0;
   
   if ($ENV{'browser.mathml'}) {    if ($ENV{'browser.mathml'}) {
     $request->content_type('text/xml');      $request->content_type('text/xml');
   } else {    } else {
     $request->content_type('text/html');      $request->content_type('text/html');
   }    }
     &Apache::loncommon::no_cache($request);
 #  $request->print(<<ENDHEADER);  
 #<html>  
 #<head>  
 #<title>Just test</title>  
 #</head>  
 #<body bgcolor="#FFFFFF">  
 #ENDHEADER  
 #  &Apache::lonhomework::send_header($request);  
   $request->send_http_header;    $request->send_http_header;
   
   return OK if $request->header_only;    return OK if $request->header_only;
   
   $request->print(&Apache::lontexconvert::header());  
   
   $request->print('<body bgcolor="#FFFFFF">'."\n");  
   
   my $file=&Apache::lonnet::filelocation("",$request->uri);    my $file=&Apache::lonnet::filelocation("",$request->uri);
   #
   # Edit action? Save file.
   #
     unless ($ENV{'request.state'} eq 'published') {
         if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {
     &storefile($file,$ENV{'form.filecont'});
         }
     }
   my %mystyle;    my %mystyle;
   my $result = '';     my $result = '';
   my $filecontents=&Apache::lonnet::getfile($file);    my $filecontents=&Apache::lonnet::getfile($file);
   if ($filecontents == -1) {    if ($filecontents == -1) {
     &Apache::lonxml::error("<b> Unable to find <i>$file</i></b>");      $result=(<<ENDNOTFOUND);
   <html>
   <head>
   <title>File not found</title>
   </head>
   <body bgcolor="#FFFFFF">
   <b>File not found: $file</b>
   </body>
   </html>
   ENDNOTFOUND
     $filecontents='';      $filecontents='';
       if ($ENV{'request.state'} ne 'published') {
         $filecontents=&createnewhtml();
         $ENV{'form.editmode'}='Edit'; #force edit mode
       }
   } else {    } else {
     $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);      unless ($ENV{'request.state'} eq 'published') {
         if ($ENV{'form.attemptclean'}) {
    $filecontents=&htmlclean($filecontents,1);
         }
       }
       if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {
         $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
     '',%mystyle);
       }
   }    }
   $request->print($result);  
   
   #
   # Edit action? Insert editing commands
   #
     unless ($ENV{'request.state'} eq 'published') {
       if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
    my $displayfile=$request->uri;
           $displayfile=~s/^\/[^\/]*//;
         $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.
                 '</h3></body></html>';
         $result=&inserteditinfo($result,$filecontents);
       }
     }
   
   $request->print('</body>');  
   $request->print(&Apache::lontexconvert::footer());  
   writeallows($request->uri);    writeallows($request->uri);
   
     $request->print($result);
   
   return OK;    return OK;
 }  }
    
 $Apache::lonxml::debug=0;  
 sub debug {  sub debug {
   if ($Apache::lonxml::debug eq 1) {    if ($Apache::lonxml::debug eq 1) {
     print "DEBUG:".$_[0]."<br>\n";      $|=1;
       print('<font size="-2"<pre>DEBUG:'.&HTML::Entities::encode($_[0])."</pre></font>\n");
   }    }
 }  }
   
 sub error {  sub error {
   if ($Apache::lonxml::debug eq 1) {    $errorcount++;
     print "ERROR:".$_[0]."<br>\n";    if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
       # If printing in construction space, put the error inside <pre></pre>
       print "<b>ERROR:</b>".join("\n",@_)."\n";
   } else {    } else {
     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";      print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
     #notify author      #notify author
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);      &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
     #notify course      #notify course
     if ( $ENV{'request.course.id'} ) {      if ( $ENV{'request.course.id'} ) {
       my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};        my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
       foreach my $user (split /\,/, $users) {        my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
  ($user,my $domain) = split /:/, $user;        foreach (keys %users) {
  &Apache::lonmsg::user_crit_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);   my ($user,$domain) = split(/:/, $_);
    &Apache::lonmsg::user_normal_msg($user,$domain,
           "Error [$declutter]",join('<br />',@_));
       }        }
     }      }
       
     #FIXME probably shouldn't have me get everything forever.      #FIXME probably shouldn't have me get everything forever.
     &Apache::lonmsg::user_crit_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);      &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
     #&Apache::lonmsg::user_crit_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);         #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
   }    }
 }  }
   
 sub warning {  sub warning {
   if ($Apache::lonxml::debug eq 1) {    $warningcount++;
     print "WARNING:".$_[0]."<br>\n";    if ($ENV{'request.state'} eq 'construct') {
       print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
     }
   }
   
   sub get_param {
       my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
       if ( ! $context ) { $context = -1; }
       my $args ='';
       if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
       if ( ! $args ) { return undef; }
       if ( $case_insensitive ) {
    if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
       return &Apache::run::run("{$args;".'return $'.$param.'}',
                                        $safeeval); #'
    } else {
       return undef;
    }
       } else {
    if ( $args =~ /my \$\Q$param\E=\"/ ) {
       return &Apache::run::run("{$args;".'return $'.$param.'}',
                                        $safeeval); #'
    } else {
       return undef;
    }
       }
   }
   
   sub get_param_var {
     my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
     if ( ! $context ) { $context = -1; }
     my $args ='';
     if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
     if ($case_insensitive) {
         if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {
     return undef;
         }
     } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }
     my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
     if ($value =~ /^[\$\@\%]/) {
       return &Apache::run::run("return $value",$safeeval,1);
     } else {
       return $value;
     }
   }
   
   sub register_insert {
     my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
     my $i;
     my $tagnum=0;
     my @order;
     for ($i=0;$i < $#data; $i++) {
       my $line = $data[$i];
       if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
       if ( $line =~ /TABLE/ ) { last; }
       my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
       if ($tag) {
         $insertlist{"$tagnum.tag"} = $tag;
         $insertlist{"$tagnum.description"} = $descrip;
         $insertlist{"$tagnum.color"} = $color;
         $insertlist{"$tagnum.function"} = $function;
         if (!defined($show)) { $show='yes'; }
         $insertlist{"$tagnum.show"}= $show;
         $insertlist{"$tag.num"}=$tagnum;
         $tagnum++;
       }
     }
     $i++; #skipping TABLE line
     $tagnum = 0;
     for (;$i < $#data;$i++) {
       my $line = $data[$i];
       my ($mnemonic,@which) = split(/ +/,$line);
       my $tag = $insertlist{"$tagnum.tag"};
       for (my $j=0;$j <=$#which;$j++) {
         if ( $which[$j] eq 'Y' ) {
    if ($insertlist{"$j.show"} ne 'no') {
     push(@{ $insertlist{"$tag.which"} },$j);
    }
         }
       }
       $tagnum++;
   }    }
 }  }
   
   sub description {
     my ($token)=@_;
     my $tagnum;
     my $tag=$token->[1];
     foreach my $namespace (reverse @Apache::lonxml::namespace) {
       my $testtag=$namespace.'::'.$tag;
       $tagnum=$insertlist{"$testtag.num"};
       if (defined($tagnum)) { last; }
     }
     if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
     return $insertlist{$tagnum.'.description'};
   }
   
   # ----------------------------------------------------------------- whichuser
   # returns a list of $symb, $courseid, $domain, $name that is correct for
   # calls to lonnet functions for this setup.
   # - looks for form.grade_ parameters
   sub whichuser {
     my ($symb,$courseid,$domain,$name);
     if (defined($ENV{'form.grade_symb'})) {
       my $tmp_courseid=$ENV{'form.grade_courseid'};
       my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);
       if ($allowed) {
         $symb=$ENV{'form.grade_symb'};
         $courseid=$ENV{'form.grade_courseid'};
         $domain=$ENV{'form.grade_domain'};
         $name=$ENV{'form.grade_username'};
       }
     } else {
       $symb=&Apache::lonnet::symbread();
       $courseid=$ENV{'request.course.id'};
       $domain=$ENV{'user.domain'};
       $name=$ENV{'user.name'};
     }
     return ($symb,$courseid,$domain,$name);
   }
   
 1;  1;
 __END__  __END__
   
   
Removed from v.1.52  
changed lines
  Added in v.1.222

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

Internal Server Error

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

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

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