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

Diff for /loncom/xml/lonxml.pm between versions 1.9 and 1.108

version 1.9, 2000/07/05 18:04:45 version 1.108, 2001/08/09 20:32:36
Line 2 Line 2
 # XML Parser Module   # XML Parser Module 
 #  #
 # last modified 06/26/00 by Alexander Sakharuk  # 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 Gerd Kortemeyer
   
 package Apache::lonxml;   package Apache::lonxml; 
   use vars 
   qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
 use strict;  use strict;
 use HTML::TokeParser;  use HTML::TokeParser;
   use HTML::TreeBuilder;
 use Safe;  use Safe;
   use Safe::Hole;
   use Math::Cephes qw(:trigs :hypers :bessels erf erfc);
   use Math::Random qw(:all);
   use Opcode;
   
 sub register {  sub register {
   my $space;    my $space;
Line 19  sub register { Line 37  sub register {
   }    }
 }  }
   
 use Apache::style;  use Apache::Constants qw(:common);
 use Apache::lontexconvert;  use Apache::lontexconvert;
   use Apache::style;
 use Apache::run;  use Apache::run;
 use Apache::londefdef;  use Apache::londefdef;
 use Apache::scripttag;  use Apache::scripttag;
   use Apache::edit;
   use Apache::lonnet;
   use Apache::File;
   
 #==================================================   Main subroutine: xmlparse    #==================================================   Main subroutine: xmlparse  
   #debugging control, to turn on debugging modify the correct handler
   $Apache::lonxml::debug=0;
   
   #path to the directory containing the file currently being processed
   @pwd=();
   
   #these two are used for capturing a subset of the output for later processing,
   #don't touch them directly use &startredirection and &endredirection
   @outputstack = ();
   $redirection = 0;
   
   #controls wheter the <import> tag actually does
   $import = 1;
   @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=();
   
   # has the dynamic menu been updated to know about this resource
   $Apache::lonxml::registered=0;
   
   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 $discussion='';
       if ($ENV{'request.course.id'}) {
          my $symb=&Apache::lonnet::symbread();
          if ($symb) {
             my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
                        $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
        $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
             if ($contrib{'version'}) {
                 $discussion.=
                     '<address><hr /><h2>Course Discussion of Resource</h2>';
                 my $idx;
                 for ($idx=1;$idx<=$contrib{'version'};$idx++) {
                     my $message=$contrib{$idx.':message'};
                     $message=~s/\n/\<br \/\>/g;
     $discussion.='<p><b>'.$contrib{$idx.':sendername'}.' at '.
         $contrib{$idx.':senderdomain'}.'</b> ('.
                         localtime($contrib{$idx.':timestamp'}).
                         '):<blockquote>'.$message.
                         '</blockquote></p>'; 
                 }
                 $discussion.='</address>';
             }
          }
       }
       return $discussion.'</html>';
   }
   
   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;
   }
   
   sub registerurl {
       my $forcereg=shift;
       if ($Apache::lonxml::registered) { return ''; }
       $Apache::lonxml::registered=1;
       if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
           my $hwkadd='';
           if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
       if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
    $hwkadd.=(<<ENDSUBM);
                        menu.switchbutton
              (7,1,'subm.gif','view sub','missions',
                   'gocmd("/adm/grades","submission")');
   ENDSUBM
               }
       if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
    $hwkadd.=(<<ENDGRDS);
                        menu.switchbutton
              (7,2,'pgrd.gif','problem','grades',
                   'gocmd("/adm/grades","viewgrades")');
   ENDGRDS
               }
       if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
    $hwkadd.=(<<ENDPARM);
                        menu.switchbutton
              (7,3,'pparm.gif','problem','parms',
                   'gocmd("/adm/parmset","set")');
   ENDPARM
               }
    }
    return (<<ENDREGTHIS);
        
   <script language="JavaScript">
   // BEGIN LON-CAPA Internal
   
       function LONCAPAreg() {
     menu=window.open("","LONCAPAmenu");
             menu.clearTimeout(menu.menucltim);
     menu.currentURL=window.location.pathname;
             menu.currentStale=0;
             menu.clearbut(3,1);
             menu.switchbutton
          (6,3,'catalog.gif','catalog','info','catalog_info()');
             menu.switchbutton
          (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)');
             menu.switchbutton
       (8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)');
             menu.switchbutton
        (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)');
             menu.switchbutton
          (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)');
             menu.switchbutton
        (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)');
             menu.switchbutton
                               (9,1,'sbkm.gif','set','bookmark','set_bookmark()');
             menu.switchbutton
                            (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()');
             menu.switchbutton
                                  (9,3,'anot.gif','anno-','tations','annotate()');
             $hwkadd
       }
   
       function LONCAPAstale() {
     menu=window.open("","LONCAPAmenu");
             menu.currentStale=1;
             menu.switchbutton
               (3,1,'reload.gif','return','location','go(currentURL)');
             menu.clearbut(7,1);
             menu.clearbut(7,2);
             menu.clearbut(7,3);
             menu.menucltim=menu.setTimeout(
    'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
    'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)',
     2000);
   
         }
   
   // END LON-CAPA Internal
   </script>
   ENDREGTHIS
   
       } else {
           return (<<ENDDONOTREGTHIS);
   
   <script language="JavaScript">
   // BEGIN LON-CAPA Internal
   
       function LONCAPAreg() {
     menu=window.open("","LONCAPAmenu");
             menu.currentStale=1;
             menu.clearbut(2,1);
             menu.clearbut(2,3);
             menu.clearbut(8,1);
             menu.clearbut(8,2);
             menu.clearbut(8,3);
             if (menu.currentURL) {
                menu.switchbutton
                 (3,1,'reload.gif','return','location','go(currentURL)');
      } else {
         menu.clearbut(3,1);
             }
       }
   
       function LONCAPAstale() {
       }
   
   // END LON-CAPA Internal
   </script>
   ENDDONOTREGTHIS
   
       }
   }
   
   sub loadevents() {
       return 'LONCAPAreg();';
   }
   
   sub unloadevents() {
       return 'LONCAPAstale();';
   }
   
   sub printalltags {
     my $temp;
     foreach $temp (sort keys %Apache::lonxml::alltags) {
       &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
     }
   }
   
 sub xmlparse {  sub xmlparse {
    my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
   
    &setup_globals($target);
    #&printalltags();
    my @pars = ();
    my $pwd=$ENV{'request.filename'};
    $pwd =~ s:/[^/]*$::;
    &newparser(\@pars,\$content_file_string,$pwd);
   
  my ($target,$content_file_string,%style_for_target) = @_;  
  my $pars = HTML::TokeParser->new(\$content_file_string);  
  my $currentstring = '';  
  my $finaloutput = '';   
  my $newarg = '';  
  my $safeeval = new Safe;   my $safeeval = new Safe;
  $safeeval->permit("entereval");   my $safehole = new Safe::Hole;
    &init_safespace($target,$safeeval,$safehole,$safeinit);
 #-------------------- 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);
   
 #------------------------- Stack definition (in stack we have all current tags)  
   
  my @stack = ();    my @stack = (); 
  my @parstack = ();   my @parstack = ();
    &initdepth;
   
    my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
      $safeeval,\%style_for_target);
   
 #------------------------------------- Parse input string (content_file_string)  
    
  my $token;  
    
  while ($token = $pars->get_token) {  
    if ($token->[0] eq 'T') {  
      $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');  
    } elsif ($token->[0] eq 'S') {  
      # add tag to stack      
      push (@stack,$token->[1]);  
      # add parameters list to another stack  
      push (@parstack,&parstring($token));  
        
      if (exists $style_for_target{$token->[1]}) {  
        #basically recurse, but we never got more than one level down so just   
        #create the new context here  
        my @innerstack = ();   
        my @innerparstack = ();  
        # use style file definition  
        $newarg = $style_for_target{$token->[1]};         
        my $pat = HTML::TokeParser->new(\$newarg);  
        my $tokenpat = '';  
        my $partstring = '';  
   
        while  ($tokenpat = $pat->get_token) {  
  if ($tokenpat->[0] eq 'T') {  
    $partstring = $tokenpat->[1];  
  } elsif ($tokenpat->[0] eq 'S') {  
    push (@innerstack,$tokenpat->[1]);  
    push (@innerparstack,&parstring($tokenpat));  
    $partstring = &callsub("start_$tokenpat->[1]",   
   $target, $tokenpat, \@innerparstack)  
  } elsif ($tokenpat->[0] eq 'E') {  
    #clear out any tags that didn't end  
    while ($tokenpat->[1] ne $innerstack[$#innerstack]   
   && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}  
    $partstring = &callsub("end_$tokenpat->[1]",  
   $target, $tokenpat, \@innerparstack)  
  }  
  #pass both the variable to the style tag, and the tag we   
  #are processing inside the <definedtag>  
  $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,  
  $parstack[$#parstack].$innerparstack[$#innerparstack]);  
  if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }  
        }  
      } else {  
        my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);  
        $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
       $parstack[$#parstack]);  
      }                
    } elsif ($token->[0] eq 'E')  {  
      #clear out any tags that didn't end  
      while ($token->[1] ne $stack[$#stack]   
     && ($#stack > 0)) {pop @stack;pop @parstack;}  
   
      if (exists $style_for_target{'/'."$token->[1]"}) {  
        my @innerstack = ();   
        my @innerparstack = ();  
        $newarg = $style_for_target{'/'."$token->[1]"};  
        my $pat = HTML::TokeParser->new(\$newarg);  
        my $tokenpat;  
        my $partstring = '';  
          
        while  ($tokenpat = $pat->get_token) {  
  if ($tokenpat->[0] eq 'T') {  
    $partstring .= $tokenpat->[1];  
  } elsif ($tokenpat->[0] eq 'S') {  
    push (@innerstack,$tokenpat->[1]);  
    push (@innerparstack,&parstring($tokenpat));  
    $partstring = &callsub("start_$tokenpat->[1]",   
   $target, $tokenpat, \@innerparstack)  
  } elsif ($tokenpat->[0] eq 'E') {  
    #clear out any tags that didn't end  
    while ($tokenpat->[1] ne $innerstack[$#innerstack]   
   && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}  
    $partstring = &callsub("end_$tokenpat->[1]",  
   $target, $tokenpat, \@innerparstack)  
  }  
  #pass both the variable to the style tag, and the tag we   
  #are processing inside the <definedtag>  
  $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,  
  $parstack[$#parstack].$innerparstack[$#innerparstack]);  
  if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }  
        }  
      } else {  
        my $result = &callsub("start_$token->[1]", $target, $token, \@parstack);  
        $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
       $parstack[$#parstack]);  
      }  
      pop @stack;   
      pop @parstack;  
    }  
  }  
  return $finaloutput;   return $finaloutput;
 }  }
   
   sub htmlclean {
       my ($raw,$full)=@_;
   
       my $tree = HTML::TreeBuilder->new;
       $tree->ignore_unknown(0);
       
       $tree->parse($raw);
   
       my $output= $tree->as_HTML(undef,' ');
        
       $output=~s/\<(br|hr|img)([^\>\/]*)\>/\<$1$2 \/\>/gis;
       $output=~s/\<\/(br|hr|img)\>//gis;
       unless ($full) {
          $output=~s/\<[\/]*(body|head|html)\>//gis;
       }
   
       $tree = $tree->delete;
   
       return $output;
   }
   
   sub inner_xmlparse {
     my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
     &Apache::lonxml::debug('Reentrant parser starting, again?');
     my $finaloutput = '';
     my $result;
     my $token;
     while ( $#$pars > -1 ) {
       while ($token = $$pars['-1']->get_token) {
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
    if ($metamode<1) {
     $result=$token->[1];
    }
         } 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 (exists $$style_for_target{$token->[1]}) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .=  
         &recurse($$style_for_target{$token->[1]},$target,$safeeval,
          $style_for_target,@$parstack);
     } else {
       $finaloutput .= &recurse($$style_for_target{$token->[1]},$target,
        $safeeval,$style_for_target,@$parstack);
     }
    } else {
     $result = &callsub("start_$token->[1]", $target, $token, $stack,
        $parstack, $pars, $safeeval, $style_for_target);
    }              
         } elsif ($token->[0] eq 'E') {
    #clear out any tags that didn't end
    while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
     &Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']");
     &end_tag($stack,$parstack,$token);
    }
   
    if (exists $$style_for_target{'/'."$token->[1]"}) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .=  
         &recurse($$style_for_target{'/'."$token->[1]"},
          $target,$safeeval,$style_for_target,@$parstack);
     } else {
       $finaloutput .= &recurse($$style_for_target{'/'."$token->[1]"},
        $target,$safeeval,$style_for_target,
        @$parstack);
     }
       
    } else {
     $result = &callsub("end_$token->[1]", $target, $token, $stack,
        $parstack, $pars,$safeeval, $style_for_target);
    }
         } else {
    &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
         }
         #evaluate variable refs in result
         if ($result ne "") {
    if ( $#$parstack > -1 ) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .= 
         &Apache::run::evaluate($result,$safeeval,$$parstack['-1']);
     } else {
       $finaloutput .= &Apache::run::evaluate($result,$safeeval,
      $$parstack['-1']);
     }
    } else {
     $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
    }
    $result = '';
         } 
         if ($token->[0] eq 'E') { 
    &end_tag($stack,$parstack,$token);
         }
       }
       pop @$pars;
       pop @Apache::lonxml::pwd;
     }
   
     # if ($target eq 'meta') {
     #   $finaloutput.=&endredirection;
     # }
   
     if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
       $finaloutput=&afterburn($finaloutput);
     }
     return $finaloutput;
   }
   
   sub recurse {
     my @innerstack = (); 
     my @innerparstack = ();
     my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
     my @pat = ();
     &newparser(\@pat,\$newarg);
     my $tokenpat;
     my $partstring = '';
     my $output='';
     my $decls='';
     while ( $#pat > -1 ) {
       while  ($tokenpat = $pat[$#pat]->get_token) {
         if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
    if ($metamode<1) { $partstring=$tokenpat->[1]; }
         } elsif ($tokenpat->[0] eq 'PI') {
    if ($metamode<1) { $partstring=$tokenpat->[2]; }
         } elsif ($tokenpat->[0] eq 'S') {
    push (@innerstack,$tokenpat->[1]);
    push (@innerparstack,&parstring($tokenpat));
    &increasedepth($tokenpat);
    $partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat,
          \@innerstack, \@innerparstack, \@pat,
          $safeeval, $style_for_target);
         } elsif ($tokenpat->[0] eq 'E') {
    #clear out any tags that didn't end
    while ($tokenpat->[1] ne $innerstack[$#innerstack] 
          && ($#innerstack > -1)) {
     &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
     &end_tag(\@innerstack,\@innerparstack,$tokenpat);
    }
    $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
          \@innerstack, \@innerparstack, \@pat,
          $safeeval, $style_for_target);
         } else {
    &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
         }
         #pass both the variable to the style tag, and the tag we 
         #are processing inside the <definedtag>
         if ( $partstring ne "" ) {
    if ( $#parstack > -1 ) { 
     if ( $#innerparstack > -1 ) { 
       $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
     } else {
       $decls= $parstack[$#parstack];
     }
    } else {
     if ( $#innerparstack > -1 ) { 
       $decls=$innerparstack[$#innerparstack];
     } else {
       $decls='';
     }
    }
    $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
    $partstring = '';
         }
         if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
    &decreasedepth($tokenpat);}
       }
       pop @pat;
       pop @Apache::lonxml::pwd;
     }
     return $output;
   }
   
 sub callsub {  sub callsub {
   my ($sub,$target,$token,@parstack)=@_;    my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $currentstring='';    my $currentstring='';
     my $nodefault;
   {    {
       my $sub1;
     no strict 'refs';      no strict 'refs';
     if (my $space=$Apache::lonxml::alltags{$token->[1]}) {      my $tag=$token->[1];
       #print "Calling sub $sub in $space \n";      my $space=$Apache::lonxml::alltags{$tag};
       $sub="$space\:\:$sub";      if (!$space) {
       $currentstring = &$sub($target,$token,\@parstack);   $tag=~tr/A-Z/a-z/;
     } else {   $sub=~tr/A-Z/a-z/;
       #print "NOT Calling sub $sub\n";   $space=$Apache::lonxml::alltags{$tag}
       if (defined($token->[4])) {      }
  $currentstring = $token->[4];  
       my $deleted=0;
       $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<br />\n");
    $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<br />\n");
    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();
     } else {
       $currentstring = $token->[2];
     }
    }
       }        }
     }      }
     use strict 'refs';      use strict 'refs';
Line 162  sub callsub { Line 526  sub callsub {
   return $currentstring;    return $currentstring;
 }  }
   
   sub setup_globals {
     my ($target)=@_;
     $Apache::lonxml::registered = 0;
     @Apache::lonxml::pwd=();
     if ($target eq 'meta') {
       $Apache::lonxml::redirection = 0;
       $Apache::lonxml::metamode = 1;
       $Apache::lonxml::evaluate = 1;
       $Apache::lonxml::import = 0;
     } 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;
     } 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::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.'";';
     $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
     &Apache::run::run($safeinit,$safeeval);
   }
   
   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 {
     @Apache::lonxml::depthcounter=();
     $Apache::lonxml::depth=-1;
     $Apache::lonxml::olddepth=-1;
   }
   
   sub increasedepth {
     my ($token) = @_;
     $Apache::lonxml::depth++;
     $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
     if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
       $Apache::lonxml::olddepth=$Apache::lonxml::depth;
     }
     my $curdepth=join('_',@Apache::lonxml::depthcounter);
     &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";
   }
   
   sub decreasedepth {
     my ($token) = @_;
     $Apache::lonxml::depth--;
     if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
       $#Apache::lonxml::depthcounter--;
       $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
     }
     if (  $Apache::lonxml::depth < -1) {
       &Apache::lonxml::warning("Unbalanced tags in resource");   
       $Apache::lonxml::depth='-1';
     }
     my $curdepth=join('_',@Apache::lonxml::depthcounter);
     &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";
   }
   
   sub get_all_text {
   
    my($tag,$pars)= @_;
    my $depth=0;
    my $token;
    my $result='';
    if ( $tag =~ m:^/: ) { 
      my $tag=substr($tag,1); 
   #   &Apache::lonxml::debug("have:$tag:");
      while (($depth >=0) && ($token = $pars->get_token)) {
   #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
        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] eq $tag) { $depth++; }
          $result.=$token->[4];
        } elsif ($token->[0] eq 'E')  {
          if ( $token->[1] eq $tag) { $depth--; }
          #skip sending back the last end tag
          if ($depth > -1) { $result.=$token->[2]; } else {
    $pars->unget_token($token);
          }
        }
      }
    } else {
      while ($token = $pars->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] eq $tag) { 
    $pars->unget_token($token); last;
          } else {
    $result.=$token->[4];
          }
        } elsif ($token->[0] eq 'E')  {
          $result.=$token->[2];
        }
      }
    }
   # &Apache::lonxml::debug("Exit:$result:");
    return $result
   }
   
   sub newparser {
     my ($parser,$contentref,$dir) = @_;
     push (@$parser,HTML::TokeParser->new($contentref));
     $$parser['-1']->xml_mode('1');
     if ( $dir eq '' ) {
       push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
     } else {
       push (@Apache::lonxml::pwd, $dir);
     } 
   #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
   #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
   }
   
 sub parstring {  sub parstring {
   my ($token) = @_;    my ($token) = @_;
   my $temp='';    my $temp='';
   map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};    map {
       unless ($_=~/\W/) {
         my $val=$token->[2]->{$_};
         $val =~ s/([\%\@\\])/\\$1/g;
         #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
         $temp .= "my \$$_=\"$val\";"
       }
     } @{$token->[3]};
   return $temp;    return $temp;
 }  }
   
   sub writeallows {
       my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
       my $thisdir=$thisurl;
       $thisdir=~s/\/[^\/]+$//;
       my %httpref=();
       map {
          $httpref{'httpref.'.
            &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;
       &Apache::lonnet::appenv(%httpref);
   }
   
   #
   # Afterburner handles anchors, highlights and links
   #
   sub afterburn {
       my $result=shift;
       map {
          my ($name, $value) = split(/=/,$_);
          $value =~ tr/+/ /;
          $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
          if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
              unless ($ENV{'form.'.$name}) {
                 $ENV{'form.'.$name}=$value;
      }
          }
       } (split(/&/,$ENV{'QUERY_STRING'}));
       if ($ENV{'form.highlight'}) {
           map {
              my $anchorname=$_;
      my $matchthis=$anchorname;
              $matchthis=~s/\_+/\\s\+/g;
              $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
          } split(/\,/,$ENV{'form.highlight'});
       }
       if ($ENV{'form.link'}) {
           map {
              my ($anchorname,$linkurl)=split(/\>/,$_);
      my $matchthis=$anchorname;
              $matchthis=~s/\_+/\\s\+/g;
              $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
          } split(/\,/,$ENV{'form.link'});
       }
       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();
       }
   }
   
   sub inserteditinfo {
         my ($result,$filecontents)=@_;
         unless ($filecontents) {
     $filecontents=(<<SIMPLECONTENT);
   <html>
   <head>
   <title>
                              Title of Document Goes Here
   </title>
   </head>
   <body bgcolor="#FFFFFF">
   
                              Body of Document Goes Here
   
   </body>
   </html>
   SIMPLECONTENT
         }
         my $editheader='<a href="#editsection">Edit below</a><hr />';
         my $editfooter=(<<ENDFOOTER);
   <hr />
   <a name="editsection" />
   <form method="post">
   <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
   <br />
   <input type="submit" name="attemptclean" 
          value="Save and then attempt to clean HTML" />
   <input type="submit" name="savethisfile" value="Save this" />
   </form>
   ENDFOOTER
         $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
         $result=~s/(\<\/body\>)/$editfooter/is;
         return $result;
   }
   
   sub handler {
     my $request=shift;
   
     my $target='web';
   
     $Apache::lonxml::debug=0;
   
     if ($ENV{'browser.mathml'}) {
       $request->content_type('text/xml');
     } else {
       $request->content_type('text/html');
     }
     
     $request->send_http_header;
     
     return OK if $request->header_only;
   
   
     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 $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='';
     } else {
         unless ($ENV{'request.state'} eq 'published') {
            if ($ENV{'form.attemptclean'}) {
       $filecontents=&htmlclean($filecontents,1);
            }
         }
       $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
     }
   
   #
   # Edit action? Insert editing commands
   #
     unless ($ENV{'request.state'} eq 'published') {
         $result=&inserteditinfo($result,$filecontents);
     }
   
     $request->print($result);
   
     writeallows($request->uri);
     return OK;
   }
    
   sub debug {
     if ($Apache::lonxml::debug eq 1) {
       print("DEBUG:".$_[0]."<br />\n");
     }
   }
   
   sub error {
     if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
       print "<b>ERROR:</b>".$_[0]."<br />\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'},$_[0]);
       #notify course
       if ( $ENV{'request.course.id'} ) {
         my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
         foreach my $user (split /\,/, $users) {
    ($user,my $domain) = split /:/, $user;
    &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
         }
       }
   
       #FIXME probably shouldn't have me get everything forever.
       &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
       #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
     }
   }
   
   sub warning {
     if ($ENV{'request.state'} eq 'construct') {
       print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
     }
   }
   
   sub get_param {
     my ($param,$parstack,$safeeval,$context) = @_;
     if ( ! $context ) { $context = -1; }
     my $args ='';
     if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
     return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
   }
   
   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);
       $insertlist{"$tagnum.tag"} = $tag;
       $insertlist{"$tagnum.description"} = $descrip;
       $insertlist{"$tagnum.color"} = $color;
       $insertlist{"$tagnum.function"} = $function;
       $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)=@_;
     return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
   }
 1;  1;
 __END__  __END__
   
   
Removed from v.1.9  
changed lines
  Added in v.1.108

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.