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

Diff for /loncom/xml/lonxml.pm between versions 1.221.2.3 and 1.433

version 1.221.2.3, 2003/03/19 21:57:59 version 1.433, 2006/12/20 22:51:27
Line 36 Line 36
 # The C source of the Code may not be distributed by the Licensee  # The C source of the Code may not be distributed by the Licensee
 # to any other parties under any circumstances.  # to any other parties under any circumstances.
 #  #
 # last modified 06/26/00 by Alexander Sakharuk  
 # 11/6 Gerd Kortemeyer  
 # 6/1/1 Gerd Kortemeyer  
 # 2/21,3/13 Guy  
 # 3/29,5/4 Gerd Kortemeyer  
 # 5/10 Scott Harrison  
 # 5/26 Gerd Kortemeyer  
 # 5/27 H. K. Ng  
 # 6/2,6/3,6/8,6/9 Gerd Kortemeyer  
 # 6/12,6/13 H. K. Ng  
 # 6/16 Gerd Kortemeyer  
 # 7/27 H. K. Ng  
 # 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer  
 # Guy Albertelli  
 # 9/26 Gerd Kortemeyer  
 # Dec Guy Albertelli  
 # YEAR=2002  
 # 1/1 Gerd Kortemeyer  
 # 1/2 Matthew Hall  
 # 1/3 Gerd Kortemeyer  
 #  
   
 package Apache::lonxml;   package Apache::lonxml; 
 use vars   use vars 
 qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode $errorcount $warningcount);  qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
 use strict;  use strict;
 use HTML::LCParser();  use HTML::LCParser();
 use HTML::TreeBuilder();  use HTML::TreeBuilder();
Line 70  use Safe::Hole(); Line 50  use Safe::Hole();
 use Math::Cephes();  use Math::Cephes();
 use Math::Random();  use Math::Random();
 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 78  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::lonfeedback();
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::loncacc();  use Apache::loncacc();
   use Apache::lonmaxima();
   use Apache::lonlocal;
   
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
 #debugging control, to turn on debugging modify the correct handler  #debugging control, to turn on debugging modify the correct handler
Line 136  $evaluate = 1; Line 124  $evaluate = 1;
 # stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
 # if 0 all high ASCII characters will be encoded into HTML Entities  
 $prevent_entity_encode=0;  
   
 # has the dynamic menu been updated to know about this resource  
 $Apache::lonxml::registered=0;  
   
 # a pointer the the Apache request object  # a pointer the the Apache request object
 $Apache::lonxml::request='';  $Apache::lonxml::request='';
   
Line 152  $Apache::lonxml::counter_changed=0; Line 134  $Apache::lonxml::counter_changed=0;
 #internal check on whether to look at style defs  #internal check on whether to look at style defs
 $Apache::lonxml::usestyle=1;  $Apache::lonxml::usestyle=1;
   
 sub xmlbegin {  #locations used to store the parameter string for style substitutions
   my $output='';  $Apache::lonxml::style_values='';
   if ($ENV{'browser.mathml'}) {  $Apache::lonxml::style_end_values='';
       $output='<?xml version="1.0"?>'  
             .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'  #array of ssi calls that need to occur after we are done parsing
             .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '  @Apache::lonxml::ssi_info=();
             .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'  
             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '   #should we do the postag variable interpolation
  .'xmlns="http://www.w3.org/TR/REC-html40">';  $Apache::lonxml::post_evaluate=1;
   } else {  
       $output='<html>';  #a header message to emit in the case of any generated warning or errors
   }  $Apache::lonxml::warnings_error_header='';
   return $output;  
   #  Control whether or not LaTeX symbols should be substituted for their
   #  \ style equivalents...this may be turned off e.g. in an verbatim
   #  environment.
   
   $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
   
   sub enable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 1;
   }
   sub disable_LaTeX_substitutions {
       $Apache::lonxml::substitute_LaTeX_symbols = 0;
 }  }
   
 sub xmlend {  sub xmlend {
     my ($discussiononly,$symb)=@_;      my ($target,$parser)=@_;
     my $discussion='';      my $mode='xml';
     if ($ENV{'request.course.id'}) {      my $status='OPEN';
        my $crs='/'.$ENV{'request.course.id'};      if ($Apache::lonhomework::parsing_a_problem ||
        if ($ENV{'request.course.sec'}) {   $Apache::lonhomework::parsing_a_task ) {
           $crs.='_'.$ENV{'request.course.sec'};   $mode='problem';
        }                    $status=$Apache::inputtags::status[-1]; 
        $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\./);  
  unless (($hidden) && (!$seeid)) {  
                  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>';  
   }  
                       }                     
                   } 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>');      my $discussion;
       &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') {
           $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 $discussion;
 }  }
   
 sub tokeninputfield {  sub tokeninputfield {
     my $defhost=$Apache::lonnet::perlvar{'lonHostID'};      my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
     $defhost=~tr/a-z/A-Z/;      $defhost=~tr/a-z/A-Z/;
     return (<<ENDINPUTFIELD)      return (<<ENDINPUTFIELD)
 <script>  <script type="text/javascript">
     function updatetoken() {      function updatetoken() {
  var comp=new Array;   var comp=new Array;
         var barcode=unescape(document.tokeninput.barcode.value);          var barcode=unescape(document.tokeninput.barcode.value);
Line 319  sub maketoken { Line 240  sub maketoken {
  $symb=&Apache::lonnet::symbread();   $symb=&Apache::lonnet::symbread();
     }      }
     unless ($tuname) {      unless ($tuname) {
  $tuname=$ENV{'user.name'};   $tuname=$env{'user.name'};
         $tudom=$ENV{'user.domain'};          $tudom=$env{'user.domain'};
         $tcrsid=$ENV{'request.course.id'};          $tcrsid=$env{'request.course.id'};
     }      }
   
     return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);      return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
Line 331  sub printtokenheader { Line 252  sub printtokenheader {
     my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;      my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
     unless ($token) { return ''; }      unless ($token) { return ''; }
   
     my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();      my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
     unless ($tsymb) {      unless ($tsymb) {
  $tsymb=$symb;   $tsymb=$symb;
     }      }
Line 341  sub printtokenheader { Line 262  sub printtokenheader {
         $tcrsid=$courseid;          $tcrsid=$courseid;
     }      }
   
     my %reply=&Apache::lonnet::get('environment',      my $plainname=&Apache::loncommon::plainname($tuname,$tudom);
               ['firstname','middlename','lastname','generation'],  
               $tudom,$tuname);  
     my $plainname=$reply{'firstname'}.' '.   
                   $reply{'middlename'}.' '.  
                   $reply{'lastname'}.' '.  
   $reply{'generation'};  
   
     if ($target eq 'web') {      if ($target eq 'web') {
         my %idhash=&Apache::lonnet::idrget($tudom,($tuname));          my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
  return    return 
  '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.   '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.
                'Checked out for '.$plainname.                 &mt('Checked out for').' '.$plainname.
                '<br />User: '.$tuname.' at '.$tudom.                 '<br />'.&mt('User').': '.$tuname.' at '.$tudom.
        '<br />ID: '.$idhash{$tuname}.         '<br />'.&mt('ID').': '.$idhash{$tuname}.
        '<br />CourseID: '.$tcrsid.         '<br />'.&mt('CourseID').': '.$tcrsid.
        '<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.         '<br />'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}.
                '<br />DocID: '.$token.                 '<br />'.&mt('DocID').': '.$token.
                '<br />Time: '.localtime().'<hr />';                 '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';
     } else {      } else {
         return $token;          return $token;
     }      }
 }  }
   
 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 {  sub printalltags {
   my $temp;    my $temp;
   foreach $temp (sort keys %Apache::lonxml::alltags) {    foreach $temp (sort keys %Apache::lonxml::alltags) {
Line 602  sub xmlparse { Line 292  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);
    &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?  # do we have a course style file?
 #  #
   
  if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') {   if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') {
      my $bodytext=       my $bodytext=
  $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};   $env{'course.'.$env{'request.course.id'}.'.default_xml_style'};
      if ($bodytext) {       if ($bodytext) {
        my $location=&Apache::lonnet::filelocation('',$bodytext);   foreach my $file (split(',',$bodytext)) {
        my $styletext=&Apache::lonnet::getfile($location);       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') {         if ($styletext ne '-1') {
           %style_for_target = (%style_for_target,            %style_for_target = (%style_for_target,
                           &Apache::style::styleparser($target,$styletext));                            &Apache::style::styleparser($target,$styletext));
        }        }
     }  
  }   }
   #&printalltags();
  #&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 634  sub xmlparse { Line 338  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'});   if (@stack) {
        &warning("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() }   if ($Apache::lonxml::counter_changed) { &store_counter() }
  return $finaloutput;  
 }  
   
 sub htmlclean {  
     my ($raw,$full)=@_;  
   
     my $tree = HTML::TreeBuilder->new;  
     $tree->ignore_unknown(0);  
   
     $tree->parse($raw);   &clean_safespace($safeeval);
   
     my $output= $tree->as_HTML(undef,' ');   if ($env{'form.return_only_error_and_warning_counts'}) {
        return "$errorcount:$warningcount";
     $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis;   }
     $output=~s/\<\/(br|hr|img|meta|allow)\>//gis;   return $finaloutput;
     unless ($full) {  
        $output=~s/\<[\/]*(body|head|html)\>//gis;  
     }  
   
     $tree = $tree->delete;  
   
     return $output;  
 }  }
   
 sub latex_special_symbols {  sub latex_special_symbols {
     my ($current_token,$stack,$parstack)=@_;      my ($string,$where)=@_;
     $current_token=~s/\\ /\\char92 /g;      #
     $current_token=~s/\^/\\char94 /g;      #  If e.g. in verbatim mode, then don't substitute.
     $current_token=~s/\~/\\char126 /g;      #  but return original string.
     $current_token=~s/(&[^a-z\#])/\\$1/g;      #
     $current_token=~s/([^&])\#/$1\\#/g;      if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
     $current_token=~s/(\$|_|{|})/\\$1/g;   return $string;
     $current_token=~s/\\char92 /\\texttt{\\char92}/g;      }
     $current_token=~s/>/\$>\$/g; #more      if ($where eq 'header') {
     $current_token=~s/</\$<\$/g; #less   $string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
     if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit   $string =~ s/(\$|%|\{|\})/\\$1/g;
     if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space   $string=&Apache::lonprintout::character_chart($string);
     return $current_token;   # 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;
 }  }
   
 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 $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) {
     my $text=$token->[1];      my $text=$token->[1];
     if ($token->[0] eq 'C' && $target eq 'tex') {      if ($token->[0] eq 'C' && $target eq 'tex') {
Line 698  sub inner_xmlparse { Line 418  sub inner_xmlparse {
     }      }
     $result.=$text;      $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 714  sub inner_xmlparse { Line 439  sub inner_xmlparse {
     my $string=$$style_for_target{$token->[1]}.      my $string=$$style_for_target{$token->[1]}.
       '<LONCAPA_INTERNAL_TURN_STYLE_ON />';        '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
     &Apache::lonxml::newparser($pars,\$string);      &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$$parstack[-1];
       $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  
  while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {  
   my $lasttag=$$stack[-1];  
   if ($token->[1] =~ /^$lasttag$/i) {  
     &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; as end tag to &lt;'.$$stack[-1].'&gt;');  
     last;  
   } else {  
     &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 &&   if ($Apache::lonxml::usestyle &&
     exists($$style_for_target{'/'."$token->[1]"})) {      exists($$style_for_target{'/'."$token->[1]"})) {
     $Apache::lonxml::usestyle=0;      $Apache::lonxml::usestyle=0;
     my $string=$$style_for_target{'/'.$token->[1]}.      my $string=$$style_for_target{'/'.$token->[1]}.
       '<LONCAPA_INTERNAL_TURN_STYLE_ON />';        '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
     &Apache::lonxml::newparser($pars,\$string);      &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
       $Apache::lonxml::style_end_values='';
       $dontpop=1;
  } else {   } else {
   $result = &callsub("end_$token->[1]", $target, $token, $stack,      #clear out any tags that didn't end
      $parstack, $pars,$safeeval, $style_for_target);      while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
    my $lasttag=$$stack[-1];
    if ($token->[1] =~ /^\Q$lasttag\E$/i) {
       &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' as end tag to &lt;'.$$stack[-1].'&gt;');
       last;
    } else {
       &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' when looking for &lt;/'.$$stack[-1].'&gt; in file');
       &end_tag($stack,$parstack,$token);
    }
       }
       $result = &callsub("end_$token->[1]", $target, $token, $stack,
          $parstack, $pars,$safeeval, $style_for_target);
  }   }
       } else {        } else {
  &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");   &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
       }        }
       #evaluate variable refs in result        #evaluate variable refs in result
       if ($result ne "") {        if ($Apache::lonxml::post_evaluate &&$result ne "") {
     my $extras;
     if (!$Apache::lonxml::usestyle) {
         $extras=$Apache::lonxml::style_values;
     }
  if ( $#$parstack > -1 ) {   if ( $#$parstack > -1 ) {
   $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);    $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
  } else {   } else {
   $result= &Apache::run::evaluate($result,$safeeval,'');    $result= &Apache::run::evaluate($result,$safeeval,$extras);
  }   }
       }        }
         $Apache::lonxml::post_evaluate=1;
   
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
  if ($target eq 'tex') {    #Style file definitions should be correct
     $result=&latex_special_symbols($result,$stack,$parstack);    if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
  }        $result=&latex_special_symbols($result);
     }
       }        }
   
       # Encode any high ASCII characters  
       if (!$Apache::lonxml::prevent_entity_encode) {  
  $result=&HTML::Entities::encode($result,"\200-\377");  
       }  
       if ($Apache::lonxml::redirection) {        if ($Apache::lonxml::redirection) {
  $Apache::lonxml::outputstack['-1'] .= $result;   $Apache::lonxml::outputstack['-1'] .= $result;
       } else {        } else {
Line 769  sub inner_xmlparse { Line 501  sub inner_xmlparse {
       }        }
       $result = '';        $result = '';
   
       if ($token->[0] eq 'E') {         if ($token->[0] eq 'E' && !$dontpop) {
  &end_tag($stack,$parstack,$token);   &end_tag($stack,$parstack,$token);
       }        }
         $dontpop=0;
     }      }
     if ($#$pars > -1) {      if ($#$pars > -1) {
  pop @$pars;   pop @$pars;
Line 783  sub inner_xmlparse { Line 516  sub inner_xmlparse {
   #   $finaloutput.=&endredirection;    #   $finaloutput.=&endredirection;
   # }    # }
   
     if ( $start && $target eq 'grade') { &endredirection(); }
     if ( $Apache::lonxml::redirection > $startredirection) {
         while ($Apache::lonxml::redirection > $startredirection) {
     $finaloutput .= &endredirection();
         }
     }
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {    if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
     $finaloutput=&afterburn($finaloutput);      $finaloutput=&afterburn($finaloutput);
   }        }    
   return $finaloutput;    return $finaloutput;
 }  }
   
   ## 
   ## Looks to see if there is a subroutine defined for this tag.  If so, call it,
   ## otherwise do not call it as we do not know what it is.
   ##
 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 798  sub callsub { Line 540  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 820  sub callsub { Line 564  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 859  sub callsub { Line 607  sub callsub {
 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;    $errorcount=0;
   $warningcount=0;    $warningcount=0;
   $Apache::lonxml::default_homework_loaded=0;    $Apache::lonxml::default_homework_loaded=0;
Line 867  sub setup_globals { Line 614  sub setup_globals {
   &init_counter();    &init_counter();
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @Apache::lonxml::ssi_info=();
     $Apache::lonxml::post_evaluate=1;
     $Apache::lonxml::warnings_error_header='';
     $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 878  sub setup_globals { Line 629  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 907  sub setup_globals { Line 658  sub setup_globals {
   
 sub init_safespace {  sub init_safespace {
   my ($target,$safeeval,$safehole,$safeinit) = @_;    my ($target,$safeeval,$safehole,$safeinit) = @_;
     $safeeval->deny_only(':dangerous');
     $safeeval->reval('use Math::Complex;');
     $safeeval->permit_only(":default");
   $safeeval->permit("entereval");    $safeeval->permit("entereval");
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
     $safeeval->permit("time");
     $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::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::caparesponse::capa_formula_fix,$safeeval,
     '&capa_formula_fix');
   
   $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 957  sub init_safespace { Line 726  sub init_safespace {
   $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );    $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
   $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');    $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');
   
     $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat');
     $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval,
     '&Math::Cephes::Matrix::new');
     $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval,
     '&Math::Cephes::Matrix::coef');
     $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval,
     '&Math::Cephes::Matrix::clr');
     $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval,
     '&Math::Cephes::Matrix::add');
     $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval,
     '&Math::Cephes::Matrix::sub');
     $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval,
     '&Math::Cephes::Matrix::mul');
     $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval,
     '&Math::Cephes::Matrix::div');
     $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval,
     '&Math::Cephes::Matrix::inv');
     $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval,
     '&Math::Cephes::Matrix::transp');
     $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval,
     '&Math::Cephes::Matrix::simq');
     $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval,
     '&Math::Cephes::Matrix::mat_to_vec');
     $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval,
     '&Math::Cephes::Matrix::vec_to_mat');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
     $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
     '&Math::Cephes::Matrix::check');
   
 #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');  #  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
 #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');  #  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
 #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');  #  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
Line 985  sub init_safespace { Line 784  sub init_safespace {
   $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');    $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
   $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');    $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
   $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');    $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
     $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
     $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
     $safehole->wrap(\&Apache::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');
   #  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);
     &initialize_rndseed($safeeval);
   }
   
   sub clean_safespace {
       my ($safeeval) = @_;
       delete_package_recurse($safeeval->{Root});
   }
   
   sub delete_package_recurse {
        my ($package) = @_;
        my @subp;
        {
    no strict 'refs';
    while (my ($key,$val) = each(%{*{"$package\::"}})) {
        if (!defined($val)) { next; }
        local (*ENTRY) = $val;
        if (defined *ENTRY{HASH} && $key =~ /::$/ &&
    $key ne "main::" && $key ne "<none>::")
        {
    my ($p) = $package ne "main" ? "$package\::" : "";
    ($p .= $key) =~ s/::$//;
    push(@subp,$p);
        }
    }
        }
        foreach my $p (@subp) {
    delete_package_recurse($p);
        }
        Symbol::delete_package($package);
   }
   
   sub initialize_rndseed {
       my ($safeeval)=@_;
       my $rndseed;
       my ($symb,$courseid,$domain,$name) = &Apache::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);
 }  }
   
 sub default_homework_load {  sub default_homework_load {
     my ($safeeval)=@_;      my ($safeeval)=@_;
     &Apache::lonxml::debug('Loading default_homework');      &Apache::lonxml::debug('Loading default_homework');
     my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');      my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
     if ($default == -1) {      if ($default eq -1) {
  &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");   &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
     } else {      } else {
  &Apache::run::run($default,$safeeval);   &Apache::run::run($default,$safeeval);
Line 1008  sub default_homework_load { Line 849  sub default_homework_load {
     }      }
 }  }
   
   {
       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 end_tag {  sub end_tag {
Line 1035  sub initdepth { Line 906  sub initdepth {
   $Apache::lonxml::olddepth=-1;    $Apache::lonxml::olddepth=-1;
 }  }
   
   my @timers;
   my $lasttime;
 sub increasedepth {  sub increasedepth {
   my ($token) = @_;    my ($token) = @_;
   $Apache::lonxml::depth++;    $Apache::lonxml::depth++;
Line 1042  sub increasedepth { Line 915  sub increasedepth {
   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {    if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth;      $Apache::lonxml::olddepth=$Apache::lonxml::depth;
   }    }
     my $time;
     if ($Apache::lonxml::debug eq "1") {
         push(@timers,[&gettimeofday()]);
         $time=&tv_interval($lasttime);
         $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x($Apache::lonxml::depth-1);
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");    &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n");
 #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";  #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
 }  }
   
Line 1055  sub decreasedepth { Line 935  sub decreasedepth {
     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;      $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
   }    }
   if (  $Apache::lonxml::depth < -1) {    if (  $Apache::lonxml::depth < -1) {
     &Apache::lonxml::warning("Missing tags, unable to properly run file.");      &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
     $Apache::lonxml::depth='-1';      $Apache::lonxml::depth='-1';
   }    }
     my ($timer,$time);
     if ($Apache::lonxml::debug eq "1") {
         $timer=pop(@timers);
         $time=&tv_interval($lasttime);
         $lasttime=[&gettimeofday()];
     }
     my $spacing='  'x$Apache::lonxml::depth;
   my $curdepth=join('_',@Apache::lonxml::depthcounter);    my $curdepth=join('_',@Apache::lonxml::depthcounter);
   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");    &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");
 #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";  #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
 }  }
   
   sub get_id {
       my ($parstack,$safeeval)=@_;
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       if ($env{'request.state'} eq 'construct' && $id =~ /(\.|_)/) {
    &error(&mt("IDs are not allowed to contain &quot;<tt>_</tt>&quot; or &quot;<tt>.</tt>&quot;"));
       }
       if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
       return $id;
   }
   
 sub get_all_text_unbalanced {  sub get_all_text_unbalanced {
 #there is a copy of this in lonpublisher.pm  #there is a copy of this in lonpublisher.pm
  my($tag,$pars)= @_;      my($tag,$pars)= @_;
  my $token;      my $token;
  my $result='';      my $result='';
  $tag='<'.$tag.'>';      $tag='<'.$tag.'>';
  while ($token = $$pars[-1]->get_token) {      while ($token = $$pars[-1]->get_token) {
    if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {   if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
      $result.=$token->[1];      if ($token->[0] eq 'T' && $token->[2]) {
    } elsif ($token->[0] eq 'PI') {   $result.='<![CDATA['.$token->[1].']]>';
      $result.=$token->[2];      } else {
    } elsif ($token->[0] eq 'S') {   $result.=$token->[1];
      $result.=$token->[4];      }
    } elsif ($token->[0] eq 'E')  {   } elsif ($token->[0] eq 'PI') {
      $result.=$token->[2];      $result.=$token->[2];
    }   } elsif ($token->[0] eq 'S') {
    if ($result =~ /(.*)\Q$tag\E(.*)/s) {      $result.=$token->[4];
      &Apache::lonxml::debug('Got a winner with leftovers ::'.$2);   } elsif ($token->[0] eq 'E')  {
      &Apache::lonxml::debug('Result is :'.$1);      $result.=$token->[2];
      $result=$1;   }
      my $redo=$tag.$2;   if ($result =~ /\Q$tag\E/is) {
      &Apache::lonxml::newparser($pars,\$redo);      ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
      last;      #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
    }      #&Apache::lonxml::debug('Result is :'.$1);
  }      $redo=$tag.$redo;
  return $result      &Apache::lonxml::newparser($pars,\$redo);
       last;
    }
       }
       return $result
 }  }
   
 sub increment_counter {  sub increment_counter {
     $Apache::lonxml::counter++;      my ($increment) = @_;
       if (defined($increment) && $increment gt 0) {
    $Apache::lonxml::counter+=$increment;
       } else {
    $Apache::lonxml::counter++;
       }
     $Apache::lonxml::counter_changed=1;      $Apache::lonxml::counter_changed=1;
 }  }
   
 sub init_counter {  sub init_counter {
     if (defined($ENV{'form.counter'})) {      if ($env{'request.state'} eq 'construct') {
  $Apache::lonxml::counter=$ENV{'form.counter'};   $Apache::lonxml::counter=1;
     } elsif (not defined($Apache::lonxml::counter)) {   $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=1;
  &store_counter();   $Apache::lonxml::counter_changed=1;
     }      }
     $Apache::lonxml::counter_changed=0;  
 }  }
   
 sub store_counter {  sub store_counter {
     &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));      &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
       $Apache::lonxml::counter_changed=0;
     return '';      return '';
 }  }
   
   {
       my $state;
       sub clear_problem_counter {
    undef($state);
    &Apache::lonnet::delenv('form.counter');
    &Apache::lonxml::init_counter();
    &Apache::lonxml::store_counter();
       }
   
       sub remember_problem_counter {
    &Apache::lonnet::transfer_profile_to_env(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'};
       }
   }
   
 sub get_all_text {  sub get_all_text {
  my($tag,$pars)= @_;      my($tag,$pars,$style)= @_;
  &Apache::lonxml::debug("Got a ".ref($pars));      my $gotfullstack=1;
  my $gotfullstack=1;      if (ref($pars) ne 'ARRAY') {
  if (ref($pars) ne 'ARRAY') {   $gotfullstack=0;
      $gotfullstack=0;   $pars=[$pars];
      $pars=[$pars];      }
  }      if (ref($style) ne 'HASH') {
  my $depth=0;   $style={};
  my $token;      }
  my $result='';      my $depth=0;
  if ( $tag =~ m:^/: ) {       my $token;
    my $tag=substr($tag,1);       my $result='';
    #&Apache::lonxml::debug("have:$tag:");      if ( $tag =~ m:^/: ) { 
    my $top_empty=0;   my $tag=substr($tag,1); 
    while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {   #&Apache::lonxml::debug("have:$tag:");
      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {   my $top_empty=0;
        #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);   while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
        if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
  $result.=$token->[1];   #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
        } elsif ($token->[0] eq 'PI') {   if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
  $result.=$token->[2];      if ($token->[2]) {
        } elsif ($token->[0] eq 'S') {   $result.='<![CDATA['.$token->[1].']]>';
  if ($token->[1] =~ /^$tag$/i) { $depth++; }      } else {
  $result.=$token->[4];   $result.=$token->[1];
        } elsif ($token->[0] eq 'E')  {      }
  if ( $token->[1] =~ /^$tag$/i) { $depth--; }   } elsif ($token->[0] eq 'PI') {
  #skip sending back the last end tag      $result.=$token->[2];
  if ($depth > -1) { $result.=$token->[2]; } else {   } elsif ($token->[0] eq 'S') {
    $$pars[-1]->unget_token($token);      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];
      if (($depth >=0) && ($#$pars > 0) ) {   } elsif ($token->[0] eq 'E')  {
        pop(@$pars);      if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; }
        pop(@Apache::lonxml::pwd);      #skip sending back the last end tag
      }      if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
      if (($depth >=0) && ($#$pars == 0) ) {        &debug("here4");$top_empty=1; }   my $string=
    }      '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
    if ($top_empty && $depth >= 0) {   $$style{'/'.$token->[1]}.
        #never found the end tag ran out of text, throw error send back blank      $token->[2].
        &error('Never found end tag for &lt;'.$tag.'&gt;');   '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
        if ($gotfullstack) {   &Apache::lonxml::newparser($pars,\$string);
    my $newstring='</'.$tag.'>'.$result;   #&Apache::lonxml::debug("reParsing $string");
    &Apache::lonxml::newparser($pars,\$newstring);   next;
        }      }
        $result='';      if ($depth > -1) {
    }   $result.=$token->[2];
  } else {      } else {
      while ($#$pars > -1) {   $$pars[-1]->unget_token($token);
  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 (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
  $result.=$token->[1];      if (($depth >=0) && ($#$pars > 0) ) {
      } elsif ($token->[0] eq 'PI') {   pop(@$pars);
  $result.=$token->[2];   pop(@Apache::lonxml::pwd);
      } elsif ($token->[0] eq 'S') {      }
  if ( $token->[1] =~ /^$tag$/i) {   }
      $$pars[-1]->unget_token($token); last;   if ($top_empty && $depth >= 0) {
  } else {      #never found the end tag ran out of text, throw error send back blank
      $result.=$token->[4];      &error('Never found end tag for &lt;'.$tag.
  }     '&gt; current string <pre>'.
      } elsif ($token->[0] eq 'E')  {     &HTML::Entities::encode($result,'<>&"').
  $result.=$token->[2];     '</pre>');
      }      if ($gotfullstack) {
  }   my $newstring='</'.$tag.'>'.$result;
  if (($#$pars > 0) ) {   &Apache::lonxml::newparser($pars,\$newstring);
      pop(@$pars);      }
      pop(@Apache::lonxml::pwd);      $result='';
  } else { last; }   }
      }      } else {
  }   while ($#$pars > -1) {
  if ($result =~ m|<LONCAPA_INTERNAL_TURN_STYLE_ON />|) {      while ($token = $$pars[-1]->get_token) {
      $Apache::lonxml::usestyle=1;   #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
  }   if (($token->[0] eq 'T')||($token->[0] eq 'C')||
  #&Apache::lonxml::debug("Exit:$result:");      ($token->[0] eq 'D')) {
  return $result      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/\/[^\/]+$//;
Line 1235  sub writeallows { Line 1210  sub writeallows {
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
 }  }
   
   sub register_ssi {
       my ($url,%form)=@_;
       push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form});
       return '';
   }
   
   sub do_registered_ssi {
       foreach my $info (@Apache::lonxml::ssi_info) {
    my %form=%{ $info->{'form'}};
    my $url=$info->{'url'};
    &Apache::lonnet::ssi($url,%form);
       }
   }
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1242  sub afterburn { Line 1230  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 1274  ENDSCRIPT Line 1262  ENDSCRIPT
   
 sub storefile {  sub storefile {
     my ($file,$contents)=@_;      my ($file,$contents)=@_;
       &Apache::lonnet::correct_line_ends(\$contents);
     if (my $fh=Apache::File->new('>'.$file)) {      if (my $fh=Apache::File->new('>'.$file)) {
  print $fh $contents;   print $fh $contents;
         $fh->close();          $fh->close();
           return 1;
     } else {      } else {
       &warning("Unable to save file $file");   &warning("Unable to save file $file");
    return 0;
     }      }
 }  }
   
 sub 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 inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents)=@_;        my ($result,$filecontents,$filetype)=@_;
       $filecontents = &HTML::Entities::encode($filecontents);        $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  #      my $editheader='<a href="#editsection">Edit below</a><hr />';
         my $xml_help = '';
         my $initialize='';
         if ($filetype eq 'html') {
     my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
     $initialize=&Apache::lonhtmlcommon::spellheader();
     if (!&Apache::lonhtmlcommon::htmlareablocked() &&
         &Apache::lonhtmlcommon::htmlareabrowser()) {
         $initialize.=(<<FULLPAGE);
   <script type="text/javascript">
   $addbuttons
   
       HTMLArea.loadPlugin("FullPage");
   
       function initDocument() {
    var editor=new HTMLArea("filecont",config);
    editor.registerPlugin(FullPage);
    editor.generate();
       }
   </script>
   FULLPAGE
             } else {
         $initialize.=(<<FULLPAGE);
   <script type="text/javascript">
   $addbuttons
       function initDocument() {
       }
   </script>
   FULLPAGE
     }
             $result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;
     $xml_help=&Apache::loncommon::helpLatexCheatsheet();
         }
         my $cleanbut = '';
   
         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');
       my $buttons=(<<BUTTONS);        my $buttons=(<<BUTTONS);
 <input type="submit" name="attemptclean"   $cleanbut
        value="Save and then attempt to clean HTML" />  <input type="submit" name="discardview" accesskey="d"  value="$lt{'dv'}" />
 <input type="submit" name="savethisfile" value="Save this" />  <input type="submit" name="Undo" accesskey="u"  value="$lt{'un'}" /><hr>
 <input type="submit" name="viewmode" value="View" />  <input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />
   <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
 BUTTONS  BUTTONS
         $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
       my $editfooter=(<<ENDFOOTER);        my $editfooter=(<<ENDFOOTER);
   $initialize
 <hr />  <hr />
 <a name="editsection" />  <a name="editsection" />
 <form method="post">  <form method="post" name="xmledit">
 <input type="hidden" name="editmode" value="Edit" />  $xml_help
   <input type="hidden" name="editmode" value="$lt{'ed'}" />
 $buttons<br />  $buttons<br />
 <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>  <textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
 <br />$buttons  <br />$buttons
 <br />  <br />
 </form>  </form>
   $titledisplay
   </body>
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;  #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
       $result=~s/(\<\/body\>)/$editfooter/is;        $result=~s/(\<\/body\>)/$editfooter/is;
Line 1328  ENDFOOTER Line 1375  ENDFOOTER
 }  }
   
 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 1355  sub get_target { Line 1402  sub get_target {
 }  }
   
 sub handler {  sub handler {
   my $request=shift;      my $request=shift;
       
   my $target=&get_target();      my $target=&get_target();
       
   $Apache::lonxml::debug=0;      $Apache::lonxml::debug=$env{'user.debug'};
       
   if ($ENV{'browser.mathml'}) {      &Apache::loncommon::content_type($request,'text/html');
     $request->content_type('text/xml');      &Apache::loncommon::no_cache($request);
   } else {      if ($env{'request.state'} eq 'published') {
     $request->content_type('text/html');   $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
   }        'lastrevisiondate'));
   &Apache::loncommon::no_cache($request);      }
   $request->send_http_header;      $request->send_http_header;
       
   return OK if $request->header_only;      return OK if $request->header_only;
   
   
   my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
       my $filetype;
       if ($file =~ /\.sty$/) {
    $filetype='sty';
       } else {
    $filetype='html';
       }
 #  #
 # Edit action? Save file.  # Edit action? Save file.
 #  #
   unless ($ENV{'request.state'} eq 'published') {      if (!($env{'request.state'} eq 'published')) {
       if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {   if ($env{'form.savethisfile'} || $env{'form.viewmode'} || $env{'form.Undo'}) {
   &storefile($file,$ENV{'form.filecont'});      my $html_file=&Apache::lonnet::getfile($file);
       }      my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'});
   }   }
   my %mystyle;  
   my $result = '';  
   my $filecontents=&Apache::lonnet::getfile($file);  
   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 %mystyle;
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,      my $result = '';
   '',%mystyle);      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 $fnf=&mt('File not found');
    $result=(<<ENDNOTFOUND);
   $start_page
   <b>$fnf: $file</b>
   $end_page
   ENDNOTFOUND
           $filecontents='';
    if ($env{'request.state'} ne 'published') {
       if ($filetype eq 'sty') {
    $filecontents=&createnewsty();
       } else {
    $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']);
    }
    &Apache::lonnet::logthis("edit mode is ".$env{'form.editmode'});
    if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) {
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
    '',%mystyle);
       undef($Apache::lonhomework::parsing_a_task);
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
       ['rawmode']);
       if ($env{'form.rawmode'}) { $result = $filecontents; }
    }
     }      }
   }      
   
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
   unless ($ENV{'request.state'} eq 'published') {      unless ($env{'request.state'} eq 'published') {
     if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {   if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
  my $displayfile=$request->uri;      {
         $displayfile=~s/^\/[^\/]*//;      my $displayfile=$request->uri;
       $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.      $displayfile=~s/^\/[^\/]*//;
               '</h3></body></html>';      my %options = ();
       $result=&inserteditinfo($result,$filecontents);      if ($env{'environment.remote'} ne 'off') {
    $options{'bgcolor'}   = '#FFFFFF';
       }
       my $start_page = &Apache::loncommon::start_page(undef,undef,
       \%options);
       $result=$start_page.
    &Apache::lonxml::message_location().'<h3>'.
    $displayfile.
    '</h3>'.&Apache::loncommon::end_page();
       $result=&inserteditinfo($result,$filecontents,$filetype);
    }
     }      }
   }      if ($filetype eq 'html') { &writeallows($request->uri); }
   
   writeallows($request->uri);      
       &Apache::lonxml::add_messages(\$result);
   $request->print($result);      $request->print($result);
       
       return OK;
   }
   
   return OK;  sub display_title {
       my $result;
       if ($env{'request.state'} eq 'construct') {
    my $title=&Apache::lonnet::gettitle();
    if (!defined($title) || $title eq '') {
       $title = $env{'request.filename'};
       $title = substr($title, rindex($title, '/') + 1);
    }
    $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>";
       }
       return $result;
 }  }
   
 sub debug {  sub debug {
   if ($Apache::lonxml::debug eq 1) {      if ($Apache::lonxml::debug eq "1") {
     $|=1;   $|=1;
     print('<font size="-2"<pre>DEBUG:'.&HTML::Entities::encode($_[0])."</pre></font>\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 error {  sub show_error_warn_msg {
   $errorcount++;      if ($env{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' &&
   if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {   &Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
     # If printing in construction space, put the error inside <pre></pre>   return 1;
     print "<b>ERROR:</b>".join("\n",@_)."\n";  
   } else {  
     print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";  
     #notify author  
     &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));  
     #notify course  
     if ( $ENV{'request.course.id'} ) {  
       my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);  
       my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});  
       foreach (keys %users) {  
  my ($user,$domain) = split(/:/, $_);  
  &Apache::lonmsg::user_normal_msg($user,$domain,  
         "Error [$declutter]",join('<br />',@_));  
       }  
     }      }
       return (($Apache::lonxml::debug eq 1) ||
       ($env{'request.state'} eq 'construct') ||
       ($Apache::lonhomework::browse eq 'F'
        &&
        $env{'form.show_errors'} eq 'on'));
   }
   
     #FIXME probably shouldn't have me get everything forever.  sub error {
     &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));      $errorcount++;
     #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);      if ( &show_error_warn_msg() ) {
   }   # If printing in construction space, put the error inside <pre></pre>
    push(@Apache::lonxml::error_messages,
        $Apache::lonxml::warnings_error_header.
        "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");
    $Apache::lonxml::warnings_error_header='';
       } else {
    my $errormsg;
    my ($symb)=&Apache::lonnet::symbread();
    if ( !$symb ) {
       #public or browsers
       $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
    }
    my $host=$Apache::lonnet::perlvar{'lonHostID'};
    my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));
    #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::lonfeedback::decide_receiver(undef,0,1,1,1);
       my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
       my @userlist;
       foreach (keys %users) {
    my ($user,$domain) = split(/:/, $_);
    push(@userlist,"$user\@$domain");
    my $key=$declutter.'_'.$user.'_'.$domain;
    my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
         [$key],
         $cdom,$cnum);
    my $now=time;
    if ($now-$lastnotified{$key}>86400) {
       &Apache::lonmsg::user_normal_msg($user,$domain,
    "Error [$declutter]",$msg);
       &Apache::lonnet::put('nohist_xmlerrornotifications',
    {$key => $now},
    $cdom,$cnum);
    }
       }
       if ($env{'request.role.adv'}) {
    $errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
       } else {
    $errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
       }
    }
    push(@Apache::lonxml::error_messages,"<b>$errormsg</b> <br />");
       }
 }  }
   
 sub warning {  sub warning {
   $warningcount++;      $warningcount++;
   if ($ENV{'request.state'} eq 'construct') {    
     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.
    "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
       $Apache::lonxml::warnings_error_header='';
    }
       }
   }
   
   sub info {
       if ($env{'form.grade_target'} ne 'tex' 
    && $env{'request.state'} eq 'construct') {
    push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n");
       }
   }
   
   sub message_location {
       return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
   }
   
   sub add_messages {
       my ($msg)=@_;
       my $result=join(' ',
       @Apache::lonxml::info_messages,
       @Apache::lonxml::error_messages,
       @Apache::lonxml::warning_messages);
       undef(@Apache::lonxml::info_messages);
       undef(@Apache::lonxml::error_messages);
       undef(@Apache::lonxml::warning_messages);
       $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
       $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
 }  }
   
 sub get_param {  sub get_param {
Line 1477  sub get_param { Line 1641  sub get_param {
     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 ( ! $Apache::lonxml::usestyle ) {
    $args=$Apache::lonxml::style_values.$args;
       }
     if ( ! $args ) { return undef; }      if ( ! $args ) { return undef; }
     if ( $case_insensitive ) {      if ( $case_insensitive ) {
  if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {   if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
     return undef;      return undef;
  }   }
     } else {      } else {
  if ( $args =~ /my \$\Q$param\E=\"/ ) {   if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
     return &Apache::run::run("{$args;".'return $'.$param.'}',      return &Apache::run::run("{$args;".'return $'.$param.'}',
                                      $safeeval); #'                                       $safeeval); #'
  } else {   } else {
Line 1500  sub get_param_var { Line 1667  sub get_param_var {
   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 ( ! $Apache::lonxml::usestyle ) {
         $args=$Apache::lonxml::style_values.$args;
     }
     &Apache::lonxml::debug("Args are $args param is $param");
   if ($case_insensitive) {    if ($case_insensitive) {
       if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {        if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
   return undef;    return undef;
       }        }
   } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { 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;
   }    }
Line 1522  sub register_insert { Line 1700  sub register_insert {
     my $line = $data[$i];      my $line = $data[$i];
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }      if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
     if ( $line =~ /TABLE/ ) { last; }      if ( $line =~ /TABLE/ ) { last; }
     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);      my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
     if ($tag) {      if ($tag) {
       $insertlist{"$tagnum.tag"} = $tag;        $insertlist{"$tagnum.tag"} = $tag;
       $insertlist{"$tagnum.description"} = $descrip;        $insertlist{"$tagnum.description"} = $descrip;
Line 1530  sub register_insert { Line 1708  sub register_insert {
       $insertlist{"$tagnum.function"} = $function;        $insertlist{"$tagnum.function"} = $function;
       if (!defined($show)) { $show='yes'; }        if (!defined($show)) { $show='yes'; }
       $insertlist{"$tagnum.show"}= $show;        $insertlist{"$tagnum.show"}= $show;
         $insertlist{"$tagnum.helpfile"} = $helpfile;
         $insertlist{"$tagnum.helpdesc"} = $helpdesc;
       $insertlist{"$tag.num"}=$tagnum;        $insertlist{"$tag.num"}=$tagnum;
       $tagnum++;        $tagnum++;
     }      }
Line 1564  sub description { Line 1744  sub description {
   return $insertlist{$tagnum.'.description'};    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 $tagnum;
 sub whichuser {    my $tag=$token->[1];
   my ($symb,$courseid,$domain,$name);    foreach my $namespace (reverse @Apache::lonxml::namespace) {
   if (defined($ENV{'form.grade_symb'})) {      my $testtag=$namespace.'::'.$tag;
     my $tmp_courseid=$ENV{'form.grade_courseid'};      $tagnum=$insertlist{"$testtag.num"};
     my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);      if (defined($tagnum)) { last; }
     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);    if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
     return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
 }  }
   
 1;  1;
Removed from v.1.221.2.3  
changed lines
  Added in v.1.433

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.