File:  [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.446: download - view: text, annotated - select for diffs
Thu May 17 21:00:59 2007 UTC (16 years, 10 months ago) by albertel
Branches: MAIN
CVS tags: version_2_4_0, version_2_3_99_0, HEAD
- show insertables by default

# The LearningOnline Network with CAPA
# XML Parser Module 
#
# $Id: lonxml.pm,v 1.446 2007/05/17 21:00:59 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 
# TtHfunc and TtMfunc (the "Code") may be compiled and linked into 
# binary executable programs or libraries distributed by the 
# Michigan State University (the "Licensee"), but any binaries so 
# distributed are hereby licensed only for use in the context
# of a program or computational system for which the Licensee is the 
# primary author or distributor, and which performs substantial 
# additional tasks beyond the translation of (La)TeX into HTML.
# The C source of the Code may not be distributed by the Licensee
# to any other parties under any circumstances.
#


package Apache::lonxml; 
use vars 
qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount);
use strict;
use LONCAPA;
use HTML::LCParser();
use HTML::TreeBuilder();
use HTML::Entities();
use Safe();
use Safe::Hole();
use Math::Cephes();
use Math::Random();
use Opcode();
use POSIX qw(strftime);
use Time::HiRes qw( gettimeofday tv_interval );
use Symbol();

sub register {
  my ($space,@taglist) = @_;
  foreach my $temptag (@taglist) {
    push(@{ $Apache::lonxml::alltags{$temptag} },$space);
  }
}

sub deregister {
  my ($space,@taglist) = @_;
  foreach my $temptag (@taglist) {
    my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
    if ($tempspace eq $space) {
      pop(@{ $Apache::lonxml::alltags{$temptag} });
    }
  }
  #&printalltags();
}

use Apache::Constants qw(:common);
use Apache::lontexconvert();
use Apache::style();
use Apache::run();
use Apache::londefdef();
use Apache::scripttag();
use Apache::languagetags();
use Apache::edit();
use Apache::inputtags();
use Apache::outputtags();
use Apache::lonnet;
use Apache::File();
use Apache::loncommon();
use Apache::lonfeedback();
use Apache::lonmsg();
use Apache::loncacc();
use Apache::lonmaxima();
use Apache::lonlocal;

#==================================================   Main subroutine: xmlparse  
#debugging control, to turn on debugging modify the correct handler
$Apache::lonxml::debug=0;

# keeps count of the number of warnings and errors generated in a parse
$warningcount=0;
$errorcount=0;

#path to the directory containing the file currently being processed
@pwd=();

#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=();

# a pointer the the Apache request object
$Apache::lonxml::request='';

# a problem number counter, and check on ether it is used
$Apache::lonxml::counter=1;
$Apache::lonxml::counter_changed=0;

#internal check on whether to look at style defs
$Apache::lonxml::usestyle=1;

#locations used to store the parameter string for style substitutions
$Apache::lonxml::style_values='';
$Apache::lonxml::style_end_values='';

#array of ssi calls that need to occur after we are done parsing
@Apache::lonxml::ssi_info=();

#should we do the postag variable interpolation
$Apache::lonxml::post_evaluate=1;

#a header message to emit in the case of any generated warning or errors
$Apache::lonxml::warnings_error_header='';

#  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 {
    my ($target,$parser)=@_;
    my $mode='xml';
    my $status='OPEN';
    if ($Apache::lonhomework::parsing_a_problem ||
	$Apache::lonhomework::parsing_a_task ) {
	$mode='problem';
	$status=$Apache::inputtags::status[-1]; 
    }
    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 {
    my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
    $defhost=~tr/a-z/A-Z/;
    return (<<ENDINPUTFIELD)
<script type="text/javascript">
    function updatetoken() {
	var comp=new Array;
        var barcode=unescape(document.tokeninput.barcode.value);
        comp=barcode.split('*');
        if (typeof(comp[0])!="undefined") {
	    document.tokeninput.codeone.value=comp[0];
	}
        if (typeof(comp[1])!="undefined") {
	    document.tokeninput.codetwo.value=comp[1];
	}
        if (typeof(comp[2])!="undefined") {
            comp[2]=comp[2].toUpperCase();
	    document.tokeninput.codethree.value=comp[2];
	}
        document.tokeninput.barcode.value='';
    }  
</script>
<form method="post" name="tokeninput">
<table border="2" bgcolor="#FFFFBB">
<tr><th>DocID Checkin</th></tr>
<tr><td>
<table>
<tr>
<td>Scan in Barcode</td>
<td><input type="text" size="22" name="barcode" 
onChange="updatetoken()"/></td>
</tr>
<tr><td><i>or</i> Type in DocID</td>
<td>
<input type="text" size="5" name="codeone" />
<b><font size="+2">*</font></b>
<input type="text" size="5" name="codetwo" />
<b><font size="+2">*</font></b>
<input type="text" size="10" name="codethree" value="$defhost" 
onChange="this.value=this.value.toUpperCase()" />
</td></tr>
</table>
</td></tr>
<tr><td><input type="submit" value="Check in DocID" /></td></tr>
</table>
</form>
ENDINPUTFIELD
}

sub maketoken {
    my ($symb,$tuname,$tudom,$tcrsid)=@_;
    unless ($symb) {
	$symb=&Apache::lonnet::symbread();
    }
    unless ($tuname) {
	$tuname=$env{'user.name'};
        $tudom=$env{'user.domain'};
        $tcrsid=$env{'request.course.id'};
    }

    return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
}

sub printtokenheader {
    my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
    unless ($token) { return ''; }

    my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
    unless ($tsymb) {
	$tsymb=$symb;
    }
    unless ($tuname) {
	$tuname=$name;
        $tudom=$domain;
        $tcrsid=$courseid;
    }

    my $plainname=&Apache::loncommon::plainname($tuname,$tudom);

    if ($target eq 'web') {
        my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
	return 
 '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'.
               &mt('Checked out for').' '.$plainname.
               '<br />'.&mt('User').': '.$tuname.' at '.$tudom.
	       '<br />'.&mt('ID').': '.$idhash{$tuname}.
	       '<br />'.&mt('CourseID').': '.$tcrsid.
	       '<br />'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}.
               '<br />'.&mt('DocID').': '.$token.
               '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';
    } else {
        return $token;
    }
}

sub printalltags {
  my $temp;
  foreach $temp (sort keys %Apache::lonxml::alltags) {
    &Apache::lonxml::debug("$temp -- ".
		  join(',',@{ $Apache::lonxml::alltags{$temp} }));
  }
}

sub xmlparse {
 my ($request,$target,$content_file_string,$safeinit,%style_for_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?
#

 if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') {
     my $bodytext=
	 $env{'course.'.$env{'request.course.id'}.'.default_xml_style'};
     if ($bodytext) {
	 foreach my $file (split(',',$bodytext)) {
	     my $location=&Apache::lonnet::filelocation('',$file);
	     my $styletext=&Apache::lonnet::getfile($location);
	     if ($styletext ne '-1') {
		 %style_for_target = (%style_for_target,
				      &Apache::style::styleparser($target,$styletext));
	     }
	 }
     }
 } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) {
     my $location=&Apache::lonnet::filelocation('',$env{'construct.style'});
     my $styletext=&Apache::lonnet::getfile($location);
       if ($styletext ne '-1') {
          %style_for_target = (%style_for_target,
                          &Apache::style::styleparser($target,$styletext));
      }
 }
#&printalltags();
 my @pars = ();
 my $pwd=$env{'request.filename'};
 $pwd =~ s:/[^/]*$::;
 &newparser(\@pars,\$content_file_string,$pwd);

 my $safeeval = new Safe;
 my $safehole = new Safe::Hole;
 &init_safespace($target,$safeeval,$safehole,$safeinit);
#-------------------- Redefinition of the target in the case of compound target

 ($target, my @tenta) = split('&&',$target);

 my @stack = ();
 my @parstack = ();
 &initdepth();
 &init_alarm();
 my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
				   $safeeval,\%style_for_target,1);

 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() }

 &clean_safespace($safeeval);

 if ($env{'form.return_only_error_and_warning_counts'}) {
     return "$errorcount:$warningcount";
 }
 return $finaloutput;
}

sub latex_special_symbols {
    my ($string,$where)=@_;
    #
    #  If e.g. in verbatim mode, then don't substitute.
    #  but return original string.
    #
    if (!($Apache::lonxml::substitute_LaTeX_symbols)) {
	return $string;
    }
    if ($where eq 'header') {
	$string =~ s/\\/\$\\backslash\$/g; # \  -> $\backslash$ per LaTex line by line pg  10.
	$string =~ s/(\$|%|\{|\})/\\$1/g;
	$string=&Apache::lonprintout::character_chart($string);
	# any & or # leftover should be safe to just escape
        $string=~s/([^\\])\&/$1\\\&/g;
        $string=~s/([^\\])\#/$1\\\#/g;
	$string =~ s/_/\\_/g;              # _ -> \_
	$string =~ s/\^/\\\^{}/g;          # ^ -> \^{} 
    } else {
	$string=~s/\\/\\ensuremath{\\backslash}/g;
	$string=~s/\\\%|\%/\\\%/g;
	$string=~s/\\{|{/\\{/g;
	$string=~s/\\}|}/\\}/g;
	$string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
	$string=~s/\\\$|\$/\\\$/g;
	$string=~s/\\\_|\_/\\\_/g;
        $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g;
	$string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less
	$string=&Apache::lonprintout::character_chart($string);
	# any & or # leftover should be safe to just escape
	$string=~s/\\\&|\&/\\\&/g;
	$string=~s/\\\#|\#/\\\#/g;
        $string=~s/\|/\$\\mid\$/g;
#single { or } How to escape?
    }
    return $string;
}

sub inner_xmlparse {
  my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
  my $finaloutput = '';
  my $result;
  my $token;
  my $dontpop=0;
  my $startredirection = $Apache::lonxml::redirection;
  while ( $#$pars > -1 ) {
    while ($token = $$pars['-1']->get_token) {
      if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
	if ($metamode<1) {
	    my $text=$token->[1];
	    if ($token->[0] eq 'C' && $target eq 'tex') {
		$text = '';
#		$text = '%'.$text."\n";
	    }
	    $result.=$text;
	}
      } elsif (($token->[0] eq 'D')) {
	if ($metamode<1 && $target eq 'web') {
	    my $text=$token->[1];
	    $result.=$text;
	}
      } elsif ($token->[0] eq 'PI') {
	if ($metamode<1 && $target eq 'web') {
	  $result=$token->[2];
	}
      } elsif ($token->[0] eq 'S') {
	# add tag to stack
	push (@$stack,$token->[1]);
	# add parameters list to another stack
	push (@$parstack,&parstring($token));
	&increasedepth($token);
	if ($Apache::lonxml::usestyle &&
	    exists($$style_for_target{$token->[1]})) {
	    $Apache::lonxml::usestyle=0;
	    my $string=$$style_for_target{$token->[1]}.
	      '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
	    &Apache::lonxml::newparser($pars,\$string);
	    $Apache::lonxml::style_values=$$parstack[-1];
	    $Apache::lonxml::style_end_values=$$parstack[-1];
	} else {
	  $result = &callsub("start_$token->[1]", $target, $token, $stack,
			     $parstack, $pars, $safeeval, $style_for_target);
	}
      } elsif ($token->[0] eq 'E') {
	if ($Apache::lonxml::usestyle &&
	    exists($$style_for_target{'/'."$token->[1]"})) {
	    $Apache::lonxml::usestyle=0;
	    my $string=$$style_for_target{'/'.$token->[1]}.
	      '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
	    &Apache::lonxml::newparser($pars,\$string);
	    $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
	    $Apache::lonxml::style_end_values='';
	    $dontpop=1;
	} else {
	    #clear out any tags that didn't end
	    while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
		my $lasttag=$$stack[-1];
		if ($token->[1] =~ /^\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 {
	&Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
      }
      #evaluate variable refs in result
      if ($Apache::lonxml::post_evaluate &&$result ne "") {
	  my $extras;
	  if (!$Apache::lonxml::usestyle) {
	      $extras=$Apache::lonxml::style_values;
	  }
	if ( $#$parstack > -1 ) {
	  $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
	} else {
	  $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') ) {
	  #Style file definitions should be correct
	  if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
	      $result=&latex_special_symbols($result);
	  }
      }

      if ($Apache::lonxml::redirection) {
	$Apache::lonxml::outputstack['-1'] .= $result;
      } else {
	$finaloutput.=$result;
      }
      $result = '';

      if ($token->[0] eq 'E' && !$dontpop) {
	&end_tag($stack,$parstack,$token);
      }
      $dontpop=0;
    }	
    if ($#$pars > -1) {
	pop @$pars;
	pop @Apache::lonxml::pwd;
    }
  }

  # if ($target eq 'meta') {
  #   $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')) {
    $finaloutput=&afterburn($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 {
  my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  my $currentstring='';
  my $nodefault;
  {
    my $sub1;
    no strict 'refs';
    my $tag=$token->[1];
# get utterly rid of extended html tags
    if ($tag=~/^x\-/i) { return ''; }
    my $space=$Apache::lonxml::alltags{$tag}[-1];
    if (!$space) {
     	$tag=~tr/A-Z/a-z/;
	$sub=~tr/A-Z/a-z/;
	$space=$Apache::lonxml::alltags{$tag}[-1]
    }

    my $deleted=0;
    if (($token->[0] eq 'S') && ($target eq 'modified')) {
      $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
					     $parstack,$parser,$safeeval,
					     $style);
    }
    if (!$deleted) {
      if ($space) {
	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
	$sub1="$space\:\:$sub";
	($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
					     $parstack,$parser,$safeeval,
					     $style);
      } else {
          if ($target eq 'tex') {
              # throw away tag name
              return '';
          }
	#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
	if ($metamode <1) {
	  if (defined($token->[4]) && ($metamode < 1)) {
	    $currentstring = $token->[4];
	  } else {
	    $currentstring = $token->[2];
	  }
	}
      }
      #    &Apache::lonxml::debug("nodefalt:$nodefault:");
      if ($currentstring eq '' && $nodefault eq '') {
	if ($target eq 'edit') {
	  #&Apache::lonxml::debug("doing default edit for $token->[1]");
	  if ($token->[0] eq 'S') {
	    $currentstring = &Apache::edit::tag_start($target,$token);
	  } elsif ($token->[0] eq 'E') {
	    $currentstring = &Apache::edit::tag_end($target,$token);
	  }
	}
      }
      if ($target eq 'modified' && $nodefault eq '') {
	  if ($currentstring eq '') {
	      if ($token->[0] eq 'S') {
		  $currentstring = $token->[4];
	      } elsif ($token->[0] eq 'E') {
		  $currentstring = $token->[2];
	      } else {
		  $currentstring = $token->[2];
	      }
	  }
	  if ($token->[0] eq 'S') {
	    $currentstring.=&Apache::edit::handle_insert();
	  } elsif ($token->[0] eq 'E') {
            $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
	  }
      }
    }
    use strict 'refs';
  }
  return $currentstring;
}

sub setup_globals {
  my ($request,$target)=@_;
  $Apache::lonxml::request=$request;
  $errorcount=0;
  $warningcount=0;
  $Apache::lonxml::default_homework_loaded=0;
  $Apache::lonxml::usestyle=1;
  &init_counter();
  @Apache::lonxml::pwd=();
  @Apache::lonxml::extlinks=();
  @Apache::lonxml::ssi_info=();
  $Apache::lonxml::post_evaluate=1;
  $Apache::lonxml::warnings_error_header='';
  $Apache::lonxml::substitute_LaTeX_symbols = 1;
  if ($target eq 'meta') {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 1;
    $Apache::lonxml::evaluate = 1;
    $Apache::lonxml::import = 0;
  } elsif ($target eq 'answer') {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 1;
    $Apache::lonxml::evaluate = 1;
    $Apache::lonxml::import = 1;
  } elsif ($target eq 'grade') {
    &startredirection(); #ended in inner_xmlparse on exit
    $Apache::lonxml::metamode = 0;
    $Apache::lonxml::evaluate = 1;
    $Apache::lonxml::import = 1;
  } elsif ($target eq 'modified') {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 0;
    $Apache::lonxml::evaluate = 0;
    $Apache::lonxml::import = 0;
  } elsif ($target eq 'edit') {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 0;
    $Apache::lonxml::evaluate = 0;
    $Apache::lonxml::import = 0;
  } elsif ($target eq 'analyze') {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 0;
    $Apache::lonxml::evaluate = 1;
    $Apache::lonxml::import = 1;
  } else {
    $Apache::lonxml::redirection = 0;
    $Apache::lonxml::metamode = 0;
    $Apache::lonxml::evaluate = 1;
    $Apache::lonxml::import = 1;
  }
}

sub init_safespace {
  my ($target,$safeeval,$safehole,$safeinit) = @_;
  $safeeval->deny_only(':dangerous');
  $safeeval->reval('use Math::Complex;');
  $safeeval->permit_only(":default");
  $safeeval->permit("entereval");
  $safeeval->permit(":base_math");
  $safeeval->permit("sort");
  $safeeval->permit("time");
  $safeeval->deny("rand");
  $safeeval->deny("srand");
  $safeeval->deny(":base_io");
  $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
  $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');
  $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  $safehole->wrap(\&Apache::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::acos,$safeeval,'&acos');
  $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
  $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh');
  $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh');
  $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh');
  $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh');
  $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh');
  $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh');
  $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf');
  $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc');
  $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0');
  $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1');
  $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn');
  $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv');
  $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0');
  $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
  $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
  $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
  
  $safehole->wrap(\&Math::Cephes::bdtr  ,$safeeval,'&bdtr'  );
  $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' );
  $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' );
  $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' );
  $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' );
  $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc');
  $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri');
  $safehole->wrap(\&Math::Cephes::fdtr  ,$safeeval,'&fdtr'  );
  $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' );
  $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' );
  $safehole->wrap(\&Math::Cephes::gdtr  ,$safeeval,'&gdtr'  );
  $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' );
  $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' );
  $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc');
  $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri');
  $safehole->wrap(\&Math::Cephes::ndtr  ,$safeeval,'&ndtr'  );
  $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' );
  $safehole->wrap(\&Math::Cephes::pdtr  ,$safeeval,'&pdtr'  );
  $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' );
  $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' );
  $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
  $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');

  $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat');
  $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval,
		  '&Math::Cephes::Matrix::new');
  $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval,
		  '&Math::Cephes::Matrix::coef');
  $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval,
		  '&Math::Cephes::Matrix::clr');
  $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval,
		  '&Math::Cephes::Matrix::add');
  $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval,
		  '&Math::Cephes::Matrix::sub');
  $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval,
		  '&Math::Cephes::Matrix::mul');
  $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval,
		  '&Math::Cephes::Matrix::div');
  $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval,
		  '&Math::Cephes::Matrix::inv');
  $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval,
		  '&Math::Cephes::Matrix::transp');
  $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval,
		  '&Math::Cephes::Matrix::simq');
  $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval,
		  '&Math::Cephes::Matrix::mat_to_vec');
  $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval,
		  '&Math::Cephes::Matrix::vec_to_mat');
  $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
		  '&Math::Cephes::Matrix::check');
  $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval,
		  '&Math::Cephes::Matrix::check');

#  $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
#  $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
#  $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
#  $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul');
#  $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv');
#  $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid');

  $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
  $safehole->wrap(\&Math::Random::random_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');
  $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
# $safeeval->deny(":base_orig");
  $safeeval->permit("require");
  $safeinit .= ';$external::target="'.$target.'";';
  &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 {
    my ($safeeval)=@_;
    &Apache::lonxml::debug('Loading default_homework');
    my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
    if ($default eq -1) {
	&Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
    } else {
	&Apache::run::run($default,$safeeval);
	$Apache::lonxml::default_homework_loaded=1;
    }
}

{
    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 {
    if (!$Apache::lonxml::redirection) {
	$metamode_was=$Apache::lonxml::metamode;
    }
    $Apache::lonxml::metamode=0;
    $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 debugging information:".join ":",caller);
	return '';
    }
    $Apache::lonxml::redirection--;
    if (!$Apache::lonxml::redirection) {
	$Apache::lonxml::metamode=$metamode_was;
    }
    pop @Apache::lonxml::outputstack;
}

sub end_tag {
  my ($tagstack,$parstack,$token)=@_;
  pop(@$tagstack);
  pop(@$parstack);
  &decreasedepth($token);
}

sub initdepth {
  @Apache::lonxml::depthcounter=();
  undef($Apache::lonxml::last_depth_count);
}


my @timers;
my $lasttime;
# @Apache::lonxml::depthcounter -> count of tags that exist so
#                                  far at each level
# $Apache::lonxml::last_depth_count -> when ascending, need to
# remember the count for the level below the current level (for
# example going from 1_2 -> 1 -> 1_3 need to remember the 2 )

sub increasedepth {
  my ($token) = @_;
  push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1);
  undef($Apache::lonxml::last_depth_count);
  my $time;
  if ($Apache::lonxml::debug eq "1") {
      push(@timers,[&gettimeofday()]);
      $time=&tv_interval($lasttime);
      $lasttime=[&gettimeofday()];
  }
  my $spacing='  'x($#Apache::lonxml::depthcounter);
  $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
#  &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time");
#print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
}

sub decreasedepth {
  my ($token) = @_;
  if (  $#Apache::lonxml::depthcounter == -1) {
      &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
  }
  $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);

  my ($timer,$time);
  if ($Apache::lonxml::debug eq "1") {
      $timer=pop(@timers);
      $time=&tv_interval($lasttime);
      $lasttime=[&gettimeofday()];
  }
  my $spacing='  'x($#Apache::lonxml::depthcounter);
  $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
#  &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}

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 {
#there is a copy of this in lonpublisher.pm
    my($tag,$pars)= @_;
    my $token;
    my $result='';
    $tag='<'.$tag.'>';
    while ($token = $$pars[-1]->get_token) {
	if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
	    if ($token->[0] eq 'T' && $token->[2]) {
		$result.='<![CDATA['.$token->[1].']]>';
	    } else {
		$result.=$token->[1];
	    }
	} elsif ($token->[0] eq 'PI') {
	    $result.=$token->[2];
	} elsif ($token->[0] eq 'S') {
	    $result.=$token->[4];
	} elsif ($token->[0] eq 'E')  {
	    $result.=$token->[2];
	}
	if ($result =~ /\Q$tag\E/is) {
	    ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
	    #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
	    #&Apache::lonxml::debug('Result is :'.$1);
	    $redo=$tag.$redo;
	    &Apache::lonxml::newparser($pars,\$redo);
	    last;
	}
    }
    return $result
}

sub increment_counter {
    my ($increment) = @_;
    if (defined($increment) && $increment gt 0) {
	$Apache::lonxml::counter+=$increment;
    } else {
	$Apache::lonxml::counter++;
    }
    $Apache::lonxml::counter_changed=1;
}

sub init_counter {
    if ($env{'request.state'} eq 'construct') {
	$Apache::lonxml::counter=1;
	$Apache::lonxml::counter_changed=1;
    } elsif (defined($env{'form.counter'})) {
	$Apache::lonxml::counter=$env{'form.counter'};
	$Apache::lonxml::counter_changed=0;
    } else {
	$Apache::lonxml::counter=1;
	$Apache::lonxml::counter_changed=1;
    }
}

sub store_counter {
    &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter));
    $Apache::lonxml::counter_changed=0;
    return '';
}

{
    my $state;
    sub clear_problem_counter {
	undef($state);
	&Apache::lonnet::delenv('form.counter');
	&Apache::lonxml::init_counter();
	&Apache::lonxml::store_counter();
    }

    sub remember_problem_counter {
	&Apache::lonnet::transfer_profile_to_env(undef,undef,1);
	$state = $env{'form.counter'};
    }

    sub restore_problem_counter {
	if (defined($state)) {
	    &Apache::lonnet::appenv(('form.counter' => $state));
	}
    }
    sub get_problem_counter {
	if ($Apache::lonxml::counter_changed) { &store_counter() }
	&Apache::lonnet::transfer_profile_to_env(undef,undef,1);
	return $env{'form.counter'};
    }
}

sub get_all_text {
    my($tag,$pars,$style)= @_;
    my $gotfullstack=1;
    if (ref($pars) ne 'ARRAY') {
	$gotfullstack=0;
	$pars=[$pars];
    }
    if (ref($style) ne 'HASH') {
	$style={};
    }
    my $depth=0;
    my $token;
    my $result='';
    if ( $tag =~ m:^/: ) { 
	my $tag=substr($tag,1); 
	#&Apache::lonxml::debug("have:$tag:");
	my $top_empty=0;
	while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
	    while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
		#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
		if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
		    if ($token->[2]) {
			$result.='<![CDATA['.$token->[1].']]>';
		    } else {
			$result.=$token->[1];
		    }
		} elsif ($token->[0] eq 'PI') {
		    $result.=$token->[2];
		} elsif ($token->[0] eq 'S') {
		    if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; }
		    if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
		    if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
		    $result.=$token->[4];
		} elsif ($token->[0] eq 'E')  {
		    if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; }
		    #skip sending back the last end tag
		    if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
			my $string=
			    '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
				$$style{'/'.$token->[1]}.
				    $token->[2].
					'<LONCAPA_INTERNAL_TURN_STYLE_ON />';
			&Apache::lonxml::newparser($pars,\$string);
			#&Apache::lonxml::debug("reParsing $string");
			next;
		    }
		    if ($depth > -1) {
			$result.=$token->[2];
		    } else {
			$$pars[-1]->unget_token($token);
		    }
		}
	    }
	    if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
	    if (($depth >=0) && ($#$pars > 0) ) {
		pop(@$pars);
		pop(@Apache::lonxml::pwd);
	    }
	}
	if ($top_empty && $depth >= 0) {
	    #never found the end tag ran out of text, throw error send back blank
	    &error('Never found end tag for &lt;'.$tag.
		   '&gt; current string <pre>'.
		   &HTML::Entities::encode($result,'<>&"').
		   '</pre>');
	    if ($gotfullstack) {
		my $newstring='</'.$tag.'>'.$result;
		&Apache::lonxml::newparser($pars,\$newstring);
	    }
	    $result='';
	}
    } else {
	while ($#$pars > -1) {
	    while ($token = $$pars[-1]->get_token) {
		#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
		if (($token->[0] eq 'T')||($token->[0] eq 'C')||
		    ($token->[0] eq 'D')) {
		    if ($token->[2]) {
			$result.='<![CDATA['.$token->[1].']]>';
		    } else {
			$result.=$token->[1];
		    }
		} elsif ($token->[0] eq 'PI') {
		    $result.=$token->[2];
		} elsif ($token->[0] eq 'S') {
		    if ( $token->[1] =~ /^\Q$tag\E$/i) {
			$$pars[-1]->unget_token($token); last;
		    } else {
			$result.=$token->[4];
		    }
		    if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
		    if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
		} elsif ($token->[0] eq 'E')  {
		    $result.=$token->[2];
		}
	    }
	    if (($#$pars > 0) ) {
		pop(@$pars);
		pop(@Apache::lonxml::pwd);
	    } else { last; }
	}
    }
    #&Apache::lonxml::debug("Exit:$result:");
    return $result
}

sub newparser {
  my ($parser,$contentref,$dir) = @_;
  push (@$parser,HTML::LCParser->new($contentref));
  $$parser[-1]->xml_mode(1);
  $$parser[-1]->marked_sections(1);
  if ( $dir eq '' ) {
    push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
  } else {
    push (@Apache::lonxml::pwd, $dir);
  } 
}

sub parstring {
    my ($token) = @_;
    my (@vars,@values);
    foreach my $attr (@{$token->[3]}) {
	if ($attr!~/\W/) {
	    my $val=$token->[2]->{$attr};
	    $val =~ s/([\%\@\\\"\'])/\\$1/g;
	    $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
	    $val =~ s/(\$)$/\\$1/;
	    #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
	    push(@vars,"\$$attr");
	    push(@values,"\"$val\"");
	}
    }
    my $var_init = 
	(@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 {
    unless ($#extlinks>=0) { return; }
    my $thisurl = &Apache::lonnet::clutter(shift);
    if ($env{'httpref.'.$thisurl}) {
	$thisurl=$env{'httpref.'.$thisurl};
    }
    my $thisdir=$thisurl;
    $thisdir=~s/\/[^\/]+$//;
    my %httpref=();
    foreach (@extlinks) {
       $httpref{'httpref.'.
 	        &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
    }
    @extlinks=();
    &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
#
sub afterburn {
    my $result=shift;
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
					    ['highlight','anchor','link']);
    if ($env{'form.highlight'}) {
       foreach (split(/\,/,$env{'form.highlight'})) {
           my $anchorname=$_;
	   my $matchthis=$anchorname;
           $matchthis=~s/\_+/\\s\+/g;
           $result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs;
       }
    }
    if ($env{'form.link'}) {
       foreach (split(/\,/,$env{'form.link'})) {
           my ($anchorname,$linkurl)=split(/\>/,$_);
	   my $matchthis=$anchorname;
           $matchthis=~s/\_+/\\s\+/g;
           $result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
       }
    }
    if ($env{'form.anchor'}) {
        my $anchorname=$env{'form.anchor'};
	my $matchthis=$anchorname;
        $matchthis=~s/\_+/\\s\+/g;
        $result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
        $result.=(<<"ENDSCRIPT");
<script type="text/javascript">
    document.location.hash='$anchorname';
</script>
ENDSCRIPT
    }
    return $result;
}

sub storefile {
    my ($file,$contents)=@_;
    &Apache::lonnet::correct_line_ends(\$contents);
    if (my $fh=Apache::File->new('>'.$file)) {
	print $fh $contents;
        $fh->close();
        return 1;
    } else {
	&warning("Unable to save file $file");
	return 0;
    }
}

sub createnewhtml {
    my $title=&mt('Title of document goes here');
    my $body=&mt('Body of document goes here');
    my $filecontents=(<<SIMPLECONTENT);
<html>
<head>
<title>$title</title>
</head>
<body bgcolor="#FFFFFF">
$body
</body>
</html>
SIMPLECONTENT
    return $filecontents;
}

sub createnewsty {
  my $filecontents=(<<SIMPLECONTENT);
<definetag name="">
    <render>
       <web></web>
       <tex></tex>
    </render>
</definetag>
SIMPLECONTENT
  return $filecontents;
}


sub inserteditinfo {
      my ($result,$filecontents,$filetype)=@_;
      $filecontents = &HTML::Entities::encode($filecontents,'<>&"');
#      my $editheader='<a href="#editsection">Edit below</a><hr />';
      my $xml_help = '';
      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);
$cleanbut
<input type="submit" name="discardview" accesskey="d"  value="$lt{'dv'}" />
<input type="submit" name="Undo" accesskey="u"  value="$lt{'un'}" /><hr>
<input type="submit" name="savethisfile" accesskey="s"  value="$lt{'st'}" />
<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
BUTTONS
      $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
      my $editfooter=(<<ENDFOOTER);
$initialize
<hr />
<a name="editsection" />
<form method="post" name="xmledit">
$xml_help
<input type="hidden" name="editmode" value="$lt{'ed'}" />
$buttons<br />
<textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
<br />$buttons
<br />
</form>
$titledisplay
</body>
ENDFOOTER
#      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
      $result=~s/(\<\/body\>)/$editfooter/is;
      return $result;
}

sub get_target {
  my $viewgrades=&Apache::lonnet::allowed('vgr',$env{'request.course.id'});
  if ( $env{'request.state'} eq 'published') {
    if ( defined($env{'form.grade_target'})
	 && ($viewgrades == 'F' )) {
      return ($env{'form.grade_target'});
    } elsif (defined($env{'form.grade_target'})) {
      if (($env{'form.grade_target'} eq 'web') ||
	  ($env{'form.grade_target'} eq 'tex') ) {
	return $env{'form.grade_target'}
      } else {
	return 'web';
      }
    } else {
      return 'web';
    }
  } elsif ($env{'request.state'} eq 'construct') {
    if ( defined($env{'form.grade_target'})) {
      return ($env{'form.grade_target'});
    } else {
      return 'web';
    }
  } else {
    return 'web';
  }
}

sub handler {
    my $request=shift;
    
    my $target=&get_target();
    
    $Apache::lonxml::debug=$env{'user.debug'};
    
    &Apache::loncommon::content_type($request,'text/html');
    &Apache::loncommon::no_cache($request);
    if ($env{'request.state'} eq 'published') {
	$request->set_last_modified(&Apache::lonnet::metadata($request->uri,
							      'lastrevisiondate'));
    }
    $request->send_http_header;
    
    return OK if $request->header_only;


    my $file=&Apache::lonnet::filelocation("",$request->uri);
    my $filetype;
    if ($file =~ /\.sty$/) {
	$filetype='sty';
    } else {
	$filetype='html';
    }
#
# Edit action? Save file.
#
    if (!($env{'request.state'} eq 'published')) {
	if ($env{'form.savethisfile'} || $env{'form.viewmode'} || $env{'form.Undo'}) {
	    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 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']);
	}
	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
#
    unless ($env{'request.state'} eq 'published') {
	if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
	    {
	    my $displayfile=$request->uri;
	    $displayfile=~s/^\/[^\/]*//;
	    my %options = ();
	    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); }
	
    
    &Apache::lonxml::add_messages(\$result);
    $request->print($result);
    
    return OK;
}

sub display_title {
    my $result;
    if ($env{'request.state'} eq 'construct') {
	my $title=&Apache::lonnet::gettitle();
	if (!defined($title) || $title eq '') {
	    $title = $env{'request.filename'};
	    $title = substr($title, rindex($title, '/') + 1);
	}
	$result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>";
    }
    return $result;
}

sub debug {
    if ($Apache::lonxml::debug eq "1") {
	$|=1;
	my $request=$Apache::lonxml::request;
	if (!$request) {
	    eval { $request=Apache->request; };
	}
	if (!$request) {
	    eval { $request=Apache2::RequestUtil->request; };
	}
	$request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
	#&Apache::lonnet::logthis($_[0]);
    }
}

sub show_error_warn_msg {
    if ($env{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' &&
	&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
	return 1;
    }
    return (($Apache::lonxml::debug eq 1) ||
	    ($env{'request.state'} eq 'construct') ||
	    ($Apache::lonhomework::browse eq 'F'
	     &&
	     $env{'form.show_errors'} eq 'on'));
}

sub error {
    $errorcount++;
    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::lonmsg::decide_receiver(undef,0,1,1,1);
	    my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
            my $baseurl = &Apache::lonnet::clutter($declutter);
	    my @userlist;
	    foreach (keys %users) {
		my ($user,$domain) = split(/:/, $_);
		push(@userlist,"$user\@$domain");
		my $key=$declutter.'_'.$user.'_'.$domain;
		my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
						      [$key],
						      $cdom,$cnum);
		my $now=time;
		if ($now-$lastnotified{$key}>86400) {
                    my $title = &Apache::lonnet::gettitle($symb);
                    my $sentmessage;
		    &Apache::lonmsg::user_normal_msg($user,$domain,
		        "Error [$title]",$msg,'',$baseurl,'','',
                        \$sentmessage,$symb,$title,1);
		    &Apache::lonnet::put('nohist_xmlerrornotifications',
					 {$key => $now},
					 $cdom,$cnum);		
		}
	    }
	    if ($env{'request.role.adv'}) {
		$errormsg=&mt("An error 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 {
    $warningcount++;
  
    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 {
    my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
    if ( ! $context ) { $context = -1; }
    my $args ='';
    if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
    if ( ! $Apache::lonxml::usestyle ) {
	$args=$Apache::lonxml::style_values.$args;
    }
    if ( ! $args ) { return undef; }
    if ( $case_insensitive ) {
	if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
	    return &Apache::run::run("{$args;".'return $'.$param.'}',
                                     $safeeval); #'
	} else {
	    return undef;
	}
    } else {
	if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
	    return &Apache::run::run("{$args;".'return $'.$param.'}',
                                     $safeeval); #'
	} else {
	    return undef;
	}
    }
}

sub get_param_var {
  my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
  if ( ! $context ) { $context = -1; }
  my $args ='';
  if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
  if ( ! $Apache::lonxml::usestyle ) {
      $args=$Apache::lonxml::style_values.$args;
  }
  &Apache::lonxml::debug("Args are $args param is $param");
  if ($case_insensitive) {
      if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) {
	  return undef;
      }
  } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
  my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
  &Apache::lonxml::debug("first run is $value");
  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 {
    return $value;
  }
}

sub register_insert_xml {
    my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
				     .'/insertlist.xml');
    my ($tagnum,$in_help)=(0,0);
    my @alltags;
    my $tag;
    while (my $token = $parser->get_token()) {
	if ($token->[0] eq 'S') {
	    my $key;
	    if      ($token->[1] eq 'tag') {
		$tag = $token->[2]{'name'};
		$insertlist{"$tagnum.tag"} = $tag;
		$insertlist{"$tag.num"}   = $tagnum;
		push(@alltags,$tag);
	    } elsif ($in_help && $token->[1] eq 'file') {
		$key = $tag.'.helpfile';
	    } elsif ($in_help && $token->[1] eq 'description') {
		$key = $tag.'.helpdesc';
	    } elsif ($token->[1] eq 'description' ||
		     $token->[1] eq 'color'       ||
		     $token->[1] eq 'show'          ) {
		$key = $tag.'.'.$token->[1];
	    } elsif ($token->[1] eq 'insert_sub') {
		$key = $tag.'.function';
	    } elsif ($token->[1] eq 'help') {
		$in_help=1;
	    } elsif ($token->[1] eq 'allow') {
		$key = $tag.'.allow';
	    }
	    if (defined($key)) {
		$insertlist{$key} = $parser->get_text();
		$insertlist{$key} =~ s/(^\s*|\s*$ )//gx;
	    }
	} elsif ($token->[0] eq 'E') {
	    if      ($token->[1] eq 'tag') {
		undef($tag);
		$tagnum++;
	    } elsif ($token->[1] eq 'help') {
		undef($in_help);
	    }
	}
    }
    
    # parse the allows and ignore tags set to <show>no</show>
    foreach my $tag (@alltags) {	
        next if (!exists($insertlist{"$tag.allow"}));
	my $allow =  $insertlist{"$tag.allow"};
       	foreach my $element (split(',',$allow)) {
	    $element =~ s/(^\s*|\s*$ )//gx;
	    if (!exists($insertlist{"$element.show"})
                || $insertlist{"$element.show"} ne 'no') {
		push(@{ $insertlist{$tag.'.which'} },$element);
	    }
	}
    }
}

sub register_insert {
    return &register_insert_xml(@_);
#    &dump_insertlist('2');
}

sub dump_insertlist {
    my ($ext) = @_;
    open(XML,">/tmp/insertlist.xml.$ext");
    print XML ("<insertlist>");
    my $i=0;

    while (exists($insertlist{"$i.tag"})) {
	my $tag = $insertlist{"$i.tag"};
	print XML ("
\t<tag name=\"$tag\">");
	if (defined($insertlist{"$tag.description"})) {
	    print XML ("
\t\t<description>".$insertlist{"$tag.description"}."</description>");
	}
	if (defined($insertlist{"$tag.color"})) {
	    print XML ("
\t\t<color>".$insertlist{"$tag.color"}."</color>");
	}
	if (defined($insertlist{"$tag.function"})) {
	    print XML ("
\t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>");
	}
	if (defined($insertlist{"$tag.show"})
	    && $insertlist{"$tag.show"} ne 'yes') {
	    print XML ("
\t\t<show>".$insertlist{"$tag.show"}."</show>");
	}
	if (defined($insertlist{"$tag.helpfile"})) {
	    print XML ("
\t\t<help>
\t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>");
	    if ($insertlist{"$tag.helpdesc"} ne '') {
		print XML ("
\t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>");
	    }
	    print XML ("
\t\t</help>");
	}
	if (defined($insertlist{"$tag.which"})) {
	    print XML ("
\t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>");
	}
	print XML ("
\t</tag>");
	$i++;
    }
    print XML ("\n</insertlist>\n");
    close(XML);
}

sub description {
    my ($token)=@_;
    my $tag = &get_tag($token);
    return $insertlist{$tag.'.description'};
}

# Returns a list containing the help file, and the description
sub helpinfo {
    my ($token)=@_;
    my $tag = &get_tag($token);
    return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
}

sub get_tag {
    my ($token)=@_;
    my $tagnum;
    my $tag=$token->[1];
    foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
	my $testtag = $namespace.'::'.$tag;
	$tagnum = $insertlist{"$testtag.num"};
	last if (defined($tagnum));
    }
    if (!defined($tagnum)) {
	$tagnum = $Apache::lonxml::insertlist{"$tag.num"};
    }
    return $insertlist{"$tagnum.tag"};
}

1;
__END__



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