# The LearningOnline Network with CAPA
# XML Parser Module 
#
# $Id: lonxml.pm,v 1.408 2006/04/18 20:50:45 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 @htmlareafields);
use strict;
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::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=();

# has the dynamic menu been updated to know about this resource
$Apache::lonxml::registered=0;

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

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

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

#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 xmlbegin {
    my ($style)=@_;
    my $output='';
    @htmlareafields=();
    if ($env{'browser.mathml'}) {
	$output='<?xml version="1.0"?>'
            #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
#            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
            
#	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
            .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
	    .'xmlns="http://www.w3.org/1999/xhtml">';
    } else {
	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
    }
    if ($style eq 'encode') {
	$output=&HTML::Entities::encode($output,'<>&"');
    }
    return $output;
}

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::lonxml::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 ($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/(\\|_|\^)/ /g;
	$string =~ s/(\$|%|\{|\})/\\$1/g;
	$string =~ s/_/ /g;
	$string=&Apache::lonprintout::character_chart($string);
	# any & or # leftover should be safe to just escape
        $string=~s/([^\\])\&/$1\\\&/g;
        $string=~s/([^\\])\#/$1\\\#/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;
    $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
    if (($token->[0] eq 'S') && ($target eq 'modified')) {
      $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
					     $parstack,$parser,$safeeval,
					     $style);
    }
    if (!$deleted) {
      if ($space) {
	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
	$sub1="$space\:\:$sub";
	($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
					     $parstack,$parser,$safeeval,
					     $style);
      } else {
          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);
	  }
	} elsif ($target eq 'modified') {
	  if ($token->[0] eq 'S') {
	    $currentstring = $token->[4];
	    $currentstring.=&Apache::edit::handle_insert();
	  } elsif ($token->[0] eq 'E') {
	    $currentstring = $token->[2];
            $currentstring.=&Apache::edit::handle_insertafter($token->[1]);
	  } else {
	    $currentstring = $token->[2];
	  }
	}
      }
    }
    use strict 'refs';
  }
  return $currentstring;
}

sub setup_globals {
  my ($request,$target)=@_;
  $Apache::lonxml::request=$request;
  $Apache::lonxml::registered = 0;
  @Apache::lonxml::htmlareafields=();
  $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(\&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::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');

#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::lonxml::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=();
  $Apache::lonxml::depth=-1;
  $Apache::lonxml::olddepth=-1;
}

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

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(&mt("Missing tags, unable to properly run file."));
    $Apache::lonxml::depth='-1';
  }
  my ($timer,$time);
  if ($Apache::lonxml::debug eq "1") {
      $timer=pop(@timers);
      $time=&tv_interval($lasttime);
      $lasttime=[&gettimeofday()];
  }
  my $spacing='  'x$Apache::lonxml::depth;
  my $curdepth=join('_',@Apache::lonxml::depthcounter);
  &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}

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();
	$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();
	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 $temp='';
  foreach (@{$token->[3]}) {
    unless ($_=~/\W/) {
      my $val=$token->[2]->{$_};
      $val =~ s/([\%\@\\\"\'])/\\$1/g;
      $val =~ s/(\$[^{a-zA-Z_])/\\$1/g;
      $val =~ s/(\$)$/\\$1/;
      #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
      $temp .= "my \$$_=\"$val\";";
    }
  }
  return $temp;
}

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,$_)}=$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::htmlareaheaders().
	      &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 this',
					 'vi' => 'View',
					 'ed' => 'Edit');
      my $buttons=(<<BUTTONS);
$cleanbut
<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');
      $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('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.
#
    unless ($env{'request.state'} eq 'published') {
	if ($env{'form.savethisfile'}) {
	    if (&storefile($file,$env{'form.filecont'})) {
		&Apache::lonxml::info("<font COLOR=\"#0000FF\">".
				      &mt('Updated').": ".
				      &Apache::lonlocal::locallocaltime(time).
				      " </font>");
	    } 
	}
    }
    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('File Error');
	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'}) {
	    $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'}))) {
	    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 $msg = join('<br />',@_);
	#notify author
	&Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
	#notify course
	if ( $symb && $env{'request.course.id'} ) {
	    my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
	    my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
	    my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
	    my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
	    my @userlist;
	    foreach (keys %users) {
		my ($user,$domain) = split(/:/, $_);
		push(@userlist,"$user\@$domain");
		my $key=$declutter.'_'.$user.'_'.$domain;
		my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
						      [$key],
						      $cdom,$cnum);
		my $now=time;
		if ($now-$lastnotified{$key}>86400) {
		    &Apache::lonmsg::user_normal_msg($user,$domain,
						 "Error [$declutter]",$msg);
		    &Apache::lonnet::put('nohist_xmlerrornotifications',
					 {$key => $now},
					 $cdom,$cnum);		
		}
	    }
	    if ($env{'request.role.adv'}) {
		$errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
	    } else {
		$errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
	    }
	}
	push(@Apache::lonxml::error_messages,"<b>$errormsg</b> <br />");
    }
}

sub warning {
    $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).$3/ei) {
	    return &Apache::run::run("{$args;".'return $'.$param.'}',
                                     $safeeval); #'
	} else {
	    return undef;
	}
    } else {
	if ( $args =~ /my \$\Q$param\E=\"/ ) {
	    return &Apache::run::run("{$args;".'return $'.$param.'}',
                                     $safeeval); #'
	} else {
	    return undef;
	}
    }
}

sub get_param_var {
  my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
  if ( ! $context ) { $context = -1; }
  my $args ='';
  if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
  if ( ! $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).$3/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 {
  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,$helpfile,$helpdesc) = split(/,/, $line);
    if ($tag) {
      $insertlist{"$tagnum.tag"} = $tag;
      $insertlist{"$tagnum.description"} = $descrip;
      $insertlist{"$tagnum.color"} = $color;
      $insertlist{"$tagnum.function"} = $function;
      if (!defined($show)) { $show='yes'; }
      $insertlist{"$tagnum.show"}= $show;
      $insertlist{"$tagnum.helpfile"} = $helpfile;
      $insertlist{"$tagnum.helpdesc"} = $helpdesc;
      $insertlist{"$tag.num"}=$tagnum;
      $tagnum++;
    }
  }
  $i++; #skipping TABLE line
  $tagnum = 0;
  for (;$i < $#data;$i++) {
    my $line = $data[$i];
    my ($mnemonic,@which) = split(/ +/,$line);
    my $tag = $insertlist{"$tagnum.tag"};
    for (my $j=0;$j <=$#which;$j++) {
      if ( $which[$j] eq 'Y' ) {
	if ($insertlist{"$j.show"} ne 'no') {
	  push(@{ $insertlist{"$tag.which"} },$j);
	}
      }
    }
    $tagnum++;
  }
}

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

# Returns a list containing the help file, and the description
sub helpinfo {
  my ($token)=@_;
  my $tagnum;
  my $tag=$token->[1];
  foreach my $namespace (reverse @Apache::lonxml::namespace) {
    my $testtag=$namespace.'::'.$tag;
    $tagnum=$insertlist{"$testtag.num"};
    if (defined($tagnum)) { last; }
  }
  if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
  return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
}

# ----------------------------------------------------------------- whichuser
# returns a list of $symb, $courseid, $domain, $name that is correct for
# calls to lonnet functions for this setup.
# - looks for form.grade_ parameters
sub whichuser {
  my ($passedsymb)=@_;
  my ($symb,$courseid,$domain,$name,$publicuser);
  if (defined($env{'form.grade_symb'})) {
      my ($tmp_courseid)=
	  &Apache::loncommon::get_env_multiple('form.grade_courseid');
      my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
      if (!$allowed && 
	  exists($env{'request.course.sec'}) && 
	  $env{'request.course.sec'} !~ /^\s*$/) {
	  $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.
					    '/'.$env{'request.course.sec'});
      }
      if ($allowed) {
	  ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');
	  $courseid=$tmp_courseid;
	  ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');
	  ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');
	  return ($symb,$courseid,$domain,$name,$publicuser);
      }
  }
  if (!$passedsymb) {
      $symb=&Apache::lonnet::symbread();
  } else {
      $symb=$passedsymb;
  }
  $courseid=$env{'request.course.id'};
  $domain=$env{'user.domain'};
  $name=$env{'user.name'};
  if ($name eq 'public' && $domain eq 'public') {
      if (!defined($env{'form.username'})) {
	  $env{'form.username'}.=time.rand(10000000);
      }
      $name.=$env{'form.username'};
  }
  return ($symb,$courseid,$domain,$name,$publicuser);
}

1;
__END__