loncom/xml/lonxml.pm - diff

Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.294 and 1.409

version 1.294, 2003/11/21 18:54:10	version 1.409, 2006/04/18 20:55:26
Line 36	Line 36
# The C source of the Code may not be distributed by the Licensee	# The C source of the Code may not be distributed by the Licensee
# to any other parties under any circumstances.	# to any other parties under any circumstances.
#	#
# last modified 06/26/00 by Alexander Sakharuk
# 11/6 Gerd Kortemeyer
# 6/1/1 Gerd Kortemeyer
# 2/21,3/13 Guy
# 3/29,5/4 Gerd Kortemeyer
# 5/26 Gerd Kortemeyer
# 5/27 H. K. Ng
# 6/2,6/3,6/8,6/9 Gerd Kortemeyer
# 6/12,6/13 H. K. Ng
# 6/16 Gerd Kortemeyer
# 7/27 H. K. Ng
# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
# Guy Albertelli
# 9/26 Gerd Kortemeyer
# Dec Guy Albertelli
# YEAR=2002
# 1/1 Gerd Kortemeyer
# 1/2 Matthew Hall
# 1/3 Gerd Kortemeyer
#

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

sub register {	sub register {
my ($space,@taglist) = @_;	my ($space,@taglist) = @_;
Line 100 use Apache::languagetags();	Line 82 use Apache::languagetags();
use Apache::edit();	use Apache::edit();
use Apache::inputtags();	use Apache::inputtags();
use Apache::outputtags();	use Apache::outputtags();
use Apache::lonnet();	use Apache::lonnet;
use Apache::File();	use Apache::File();
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonfeedback();	use Apache::lonfeedback();
Line 141 $evaluate = 1;	Line 123 $evaluate = 1;
# stores the list of active tag namespaces	# stores the list of active tag namespaces
@namespace=();	@namespace=();

# if 0 all high ASCII characters will be encoded into HTML Entities
$prevent_entity_encode=0;

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

Line 167 $Apache::lonxml::style_end_values='';	Line 146 $Apache::lonxml::style_end_values='';
#should we do the postag variable interpolation	#should we do the postag variable interpolation
$Apache::lonxml::post_evaluate=1;	$Apache::lonxml::post_evaluate=1;

sub xmlbegin {	#a header message to emit in the case of any generated warning or errors
my $output='';	$Apache::lonxml::warnings_error_header='';
if ($ENV{'browser.mathml'}) {
$output='<?xml version="1.0"?>'	# Control whether or not LaTeX symbols should be substituted for their
.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'	# \ style equivalents...this may be turned off e.g. in an verbatim
.'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '	# environment.
.'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '	$Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
.'xmlns="http://www.w3.org/TR/REC-html40">';
} else {	sub enable_LaTeX_substitutions {
$output='<html>';	$Apache::lonxml::substitute_LaTeX_symbols = 1;
}	}
return $output;	sub disable_LaTeX_substitutions {
	$Apache::lonxml::substitute_LaTeX_symbols = 0;
}	}

sub xmlend {	sub xmlend {
	my ($target,$parser)=@_;
my $mode='xml';	my $mode='xml';
my $status='OPEN';	my $status='OPEN';
if ($Apache::lonhomework::parsing_a_problem) {	if ($Apache::lonhomework::parsing_a_problem \|\|
	$Apache::lonhomework::parsing_a_task ) {
$mode='problem';	$mode='problem';
$status=$Apache::inputtags::status[-1];	$status=$Apache::inputtags::status[-1];
}	}
return &Apache::lonfeedback::list_discussion().'</html>';	my $discussion;
	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
	['LONCAPA_INTERNAL_no_discussion']);
	if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) \|\|
	$env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {
	$discussion=&Apache::lonfeedback::list_discussion($mode,$status);
	}
	if ($target eq 'tex') {
	$discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
	&Apache::lonxml::newparser($parser,\$discussion,'');
	return '';
	}

	return $discussion;
}	}

sub tokeninputfield {	sub tokeninputfield {
Line 247 sub maketoken {	Line 242 sub maketoken {
$symb=&Apache::lonnet::symbread();	$symb=&Apache::lonnet::symbread();
}	}
unless ($tuname) {	unless ($tuname) {
$tuname=$ENV{'user.name'};	$tuname=$env{'user.name'};
$tudom=$ENV{'user.domain'};	$tudom=$env{'user.domain'};
$tcrsid=$ENV{'request.course.id'};	$tcrsid=$env{'request.course.id'};
}	}

return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);	return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
Line 269 sub printtokenheader {	Line 264 sub printtokenheader {
$tcrsid=$courseid;	$tcrsid=$courseid;
}	}

my %reply=&Apache::lonnet::get('environment',	my $plainname=&Apache::loncommon::plainname($tuname,$tudom);
['firstname','middlename','lastname','generation'],
$tudom,$tuname);
my $plainname=$reply{'firstname'}.' '.
$reply{'middlename'}.' '.
$reply{'lastname'}.' '.
$reply{'generation'};

if ($target eq 'web') {	if ($target eq 'web') {
my %idhash=&Apache::lonnet::idrget($tudom,($tuname));	my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
Line 285 sub printtokenheader {	Line 274 sub printtokenheader {
'<br />'.&mt('User').': '.$tuname.' at '.$tudom.	'<br />'.&mt('User').': '.$tuname.' at '.$tudom.
'<br />'.&mt('ID').': '.$idhash{$tuname}.	'<br />'.&mt('ID').': '.$idhash{$tuname}.
'<br />'.&mt('CourseID').': '.$tcrsid.	'<br />'.&mt('CourseID').': '.$tcrsid.
'<br />'.&mt('Course').': '.$ENV{'course.'.$tcrsid.'.description'}.	'<br />'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}.
'<br />'.&mt('DocID').': '.$token.	'<br />'.&mt('DocID').': '.$token.
'<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';	'<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />';
} else {	} else {
Line 293 sub printtokenheader {	Line 282 sub printtokenheader {
}	}
}	}

sub fontsettings() {
my $headerstring='';
if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
$headerstring.=
'<meta Content-Type="text/html; charset=x-mac-roman">';
} elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) {
$headerstring.=
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
}
return $headerstring;
}

sub printalltags {	sub printalltags {
my $temp;	my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {	foreach $temp (sort keys %Apache::lonxml::alltags) {
Line 318 sub xmlparse {	Line 295 sub xmlparse {

&setup_globals($request,$target);	&setup_globals($request,$target);
&Apache::inputtags::initialize_inputtags();	&Apache::inputtags::initialize_inputtags();
	&Apache::bridgetask::initialize_bridgetask();
&Apache::outputtags::initialize_outputtags();	&Apache::outputtags::initialize_outputtags();
&Apache::edit::initialize_edit();	&Apache::edit::initialize_edit();
&Apache::londefdef::initialize_londefdef();	&Apache::londefdef::initialize_londefdef();
Line 326 sub xmlparse {	Line 304 sub xmlparse {
# do we have a course style file?	# do we have a course style file?
#	#

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

Line 360 sub xmlparse {	Line 340 sub xmlparse {

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

if ($ENV{'request.uri'}) {	if ($env{'request.uri'}) {
&writeallows($ENV{'request.uri'});	&writeallows($env{'request.uri'});
}	}
&do_registered_ssi();	&do_registered_ssi();
if ($Apache::lonxml::counter_changed) { &store_counter() }	if ($Apache::lonxml::counter_changed) { &store_counter() }
return $finaloutput;
}

sub htmlclean {	&clean_safespace($safeeval);
my ($raw,$full)=@_;

my $tree = HTML::TreeBuilder->new;
$tree->ignore_unknown(0);

$tree->parse($raw);

my $output= $tree->as_HTML(undef,' ');

$output=~s/\<(br\|hr\|img\|meta\|allow)(.*?)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;
unless ($full) {
$output=~s/\<[\/]*(body\|head\|html)\>//gis;
}

$tree = $tree->delete;	if ($env{'form.return_only_error_and_warning_counts'}) {
	return "$errorcount:$warningcount";
return $output;	}
	return $finaloutput;
}	}

sub latex_special_symbols {	sub latex_special_symbols {
my ($string,$where)=@_;	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') {	if ($where eq 'header') {
$string =~ s/(\\\|_\|\^)/ /g;	$string =~ s/(\\\|_\|\^)/ /g;
$string =~ s/(\$\|%\|\#\|&\|\{\|\})/\\$1/g;	$string =~ s/(\$\|%\|\{\|\})/\\$1/g;
$string =~ s/_/ /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 {	} else {
$string=~s/\\ /\\char92 /g;	$string=~s/\\/\\ensuremath{\\backslash}/g;
$string=~s/\^/\\\^ /g;	$string=~s/\\\%\|\%/\\\%/g;
$string=~s/\~/\\char126 /g;	$string=~s/\\{\|{/\\{/g;
#fixup & if it doesn't look like	$string=~s/\\}\|}/\\}/g;
# { or α	$string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
$string=~s/(&(?!((\#[0-9]+)\|([a-z]+));))/\\$1/gi;	$string=~s/\\\$\|\$/\\\$/g;
$string=~s/([^&])\#/$1\\#/g;	$string=~s/\\\_\|\_/\\\_/g;
$string=~s/(\$\|_\|{\|})/\\$1/g;	$string=~s/([^\\]\|^)(\~\|\^)/$1\\$2\\strut /g;
$string=~s/\\char92 /\\texttt{\\char92}/g;	$string=~s/(>\|<)/\\ensuremath\{$1\}/g; #more or less
$string=~s/(>\|<)/\$$1\$/g; #more or less	$string=&Apache::lonprintout::character_chart($string);
if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit	# any & or # leftover should be safe to just escape
if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space	$string=~s/\\\&\|\&/\\\&/g;
if ($string eq '%.') {$string = '\%.';} #percent at the end of statement	$string=~s/\\\#\|\#/\\\#/g;
	$string=~s/\\|/\$\\mid\$/g;
	#single { or } How to escape?
}	}
return $string;	return $string;
}	}

sub inner_xmlparse {	sub inner_xmlparse {
my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;	my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_;
my $finaloutput = '';	my $finaloutput = '';
my $result;	my $result;
my $token;	my $token;
my $dontpop=0;	my $dontpop=0;
	my $startredirection = $Apache::lonxml::redirection;
while ( $#$pars > -1 ) {	while ( $#$pars > -1 ) {
while ($token = $$pars['-1']->get_token) {	while ($token = $$pars['-1']->get_token) {
if (($token->[0] eq 'T') \|\| ($token->[0] eq 'C') ) {	if (($token->[0] eq 'T') \|\| ($token->[0] eq 'C') ) {
Line 476 sub inner_xmlparse {	Line 455 sub inner_xmlparse {
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {	while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
my $lasttag=$$stack[-1];	my $lasttag=$$stack[-1];
if ($token->[1] =~ /^$lasttag$/i) {	if ($token->[1] =~ /^\Q$lasttag\E$/i) {
&Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>');	&Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>');
last;	last;
} else {	} else {
Line 511 sub inner_xmlparse {	Line 490 sub inner_xmlparse {
}	}
}	}

# Encode any high ASCII characters
# if (!$Apache::lonxml::prevent_entity_encode) {
# $result=&HTML::Entities::encode($result,"\200-\377");
# }
if ($Apache::lonxml::redirection) {	if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .= $result;	$Apache::lonxml::outputstack['-1'] .= $result;
} else {	} else {
Line 537 sub inner_xmlparse {	Line 512 sub inner_xmlparse {
# $finaloutput.=&endredirection;	# $finaloutput.=&endredirection;
# }	# }

	if ( $start && $target eq 'grade') { &endredirection(); }
	if ( $Apache::lonxml::redirection > $startredirection) {
	while ($Apache::lonxml::redirection > $startredirection) {
	$finaloutput .= &endredirection();
	}
	}
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {	if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);	$finaloutput=&afterburn($finaloutput);
}	}
return $finaloutput;	return $finaloutput;
}	}

	##
	## Looks to see if there is a subroutine defined for this tag. If so, call it,
	## otherwise do not call it as we do not know what it is.
	##
sub callsub {	sub callsub {
my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';	my $currentstring='';
Line 576 sub callsub {	Line 560 sub callsub {
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
$style);	$style);
} else {	} else {
	if ($target eq 'tex') {
	# throw away tag name
	return '';
	}
#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");	#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {	if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {	if (defined($token->[4]) && ($metamode < 1)) {
Line 616 sub setup_globals {	Line 604 sub setup_globals {
my ($request,$target)=@_;	my ($request,$target)=@_;
$Apache::lonxml::request=$request;	$Apache::lonxml::request=$request;
$Apache::lonxml::registered = 0;	$Apache::lonxml::registered = 0;
	@Apache::lonxml::htmlareafields=();
$errorcount=0;	$errorcount=0;
$warningcount=0;	$warningcount=0;
$Apache::lonxml::default_homework_loaded=0;	$Apache::lonxml::default_homework_loaded=0;
Line 625 sub setup_globals {	Line 614 sub setup_globals {
@Apache::lonxml::extlinks=();	@Apache::lonxml::extlinks=();
@Apache::lonxml::ssi_info=();	@Apache::lonxml::ssi_info=();
$Apache::lonxml::post_evaluate=1;	$Apache::lonxml::post_evaluate=1;
	$Apache::lonxml::warnings_error_header='';
	$Apache::lonxml::substitute_LaTeX_symbols = 1;
if ($target eq 'meta') {	if ($target eq 'meta') {
$Apache::lonxml::redirection = 0;	$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;	$Apache::lonxml::metamode = 1;
Line 636 sub setup_globals {	Line 627 sub setup_globals {
$Apache::lonxml::evaluate = 1;	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;	$Apache::lonxml::import = 1;
} elsif ($target eq 'grade') {	} elsif ($target eq 'grade') {
&startredirection;	&startredirection(); #ended in inner_xmlparse on exit
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 1;	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;	$Apache::lonxml::import = 1;
Line 665 sub setup_globals {	Line 656 sub setup_globals {

sub init_safespace {	sub init_safespace {
my ($target,$safeeval,$safehole,$safeinit) = @_;	my ($target,$safeeval,$safehole,$safeinit) = @_;
	$safeeval->deny_only(':dangerous');
	$safeeval->reval('use Math::Complex;');
	$safeeval->permit_only(":default");
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
$safeeval->permit("sort");	$safeeval->permit("sort");
$safeeval->permit("time");	$safeeval->permit("time");
	$safeeval->deny("rand");
	$safeeval->deny("srand");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');	$safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
$safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');	$safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
	$safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
	'&chem_standard_order');
	$safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');

$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');	$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');	$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');	$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
Line 717 sub init_safespace {	Line 716 sub init_safespace {
$safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );	$safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' );
$safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');	$safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri');

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

# $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');	# $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract');
# $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');	# $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd');
# $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');	# $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub');
Line 745 sub init_safespace {	Line 774 sub init_safespace {
$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');	$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
$safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');	$safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');	$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
	$safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
	$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
	$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');

#need to inspect this class of ops	#need to inspect this class of ops
# $safeeval->deny(":base_orig");	# $safeeval->deny(":base_orig");
	$safeeval->permit("require");
$safeinit .= ';$external::target="'.$target.'";';	$safeinit .= ';$external::target="'.$target.'";';
my $rndseed;
my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
$rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
$safeinit .= ';$external::randomseed='.$rndseed.';';
&Apache::lonxml::debug("Setting rndseed to $rndseed");
&Apache::run::run($safeinit,$safeeval);	&Apache::run::run($safeinit,$safeeval);
	&initialize_rndseed($safeeval);
	}

	sub clean_safespace {
	my ($safeeval) = @_;
	delete_package_recurse($safeeval->{Root});
	}

	sub delete_package_recurse {
	my ($package) = @_;
	my @subp;
	{
	no strict 'refs';
	while (my ($key,$val) = each(%{*{"$package\::"}})) {
	if (!defined($val)) { next; }
	local (*ENTRY) = $val;
	if (defined *ENTRY{HASH} && $key =~ /::$/ &&
	$key ne "main::" && $key ne "<none>::")
	{
	my ($p) = $package ne "main" ? "$package\::" : "";
	($p .= $key) =~ s/::$//;
	push(@subp,$p);
	}
	}
	}
	foreach my $p (@subp) {
	delete_package_recurse($p);
	}
	Symbol::delete_package($package);
	}

	sub initialize_rndseed {
	my ($safeeval)=@_;
	my $rndseed;
	my ($symb,$courseid,$domain,$name) = &Apache::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 {	sub default_homework_load {
Line 769 sub default_homework_load {	Line 836 sub default_homework_load {
}	}
}	}

	{
	my $alarm_depth;
	sub init_alarm {
	alarm(0);
	$alarm_depth=0;
	}

	sub start_alarm {
	if ($alarm_depth<1) {
	my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'});
	if ($old) {
	&Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur.");
	}
	}
	$alarm_depth++;
	}

	sub end_alarm {
	$alarm_depth--;
	if ($alarm_depth<1) { alarm(0); }
	}
	}
	my $metamode_was;
sub startredirection {	sub startredirection {
$Apache::lonxml::redirection++;	if (!$Apache::lonxml::redirection) {
push (@Apache::lonxml::outputstack, '');	$metamode_was=$Apache::lonxml::metamode;
	}
	$Apache::lonxml::metamode=0;
	$Apache::lonxml::redirection++;
	push (@Apache::lonxml::outputstack, '');
}	}

sub endredirection {	sub endredirection {
if (!$Apache::lonxml::redirection) {	if (!$Apache::lonxml::redirection) {
&Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);	&Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller);
return '';	return '';
}	}
$Apache::lonxml::redirection--;	$Apache::lonxml::redirection--;
pop @Apache::lonxml::outputstack;	if (!$Apache::lonxml::redirection) {
	$Apache::lonxml::metamode=$metamode_was;
	}
	pop @Apache::lonxml::outputstack;
}	}

sub end_tag {	sub end_tag {
Line 796 sub initdepth {	Line 893 sub initdepth {
$Apache::lonxml::olddepth=-1;	$Apache::lonxml::olddepth=-1;
}	}

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

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

	sub get_id {
	my ($parstack,$safeeval)=@_;
	my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
	if ($env{'request.state'} eq 'construct' && $id =~ /(\.\|_)/) {
	&error(&mt("IDs are not allowed to contain "<tt>_</tt>" or "<tt>.</tt>""));
	}
	if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; }
	return $id;
	}

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

sub increment_counter {	sub increment_counter {
Line 863 sub increment_counter {	Line 990 sub increment_counter {
}	}

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

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

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

	sub remember_problem_counter {
	&Apache::lonnet::transfer_profile_to_env();
	$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 {	sub get_all_text {
my($tag,$pars,$style)= @_;	my($tag,$pars,$style)= @_;
my $gotfullstack=1;	my $gotfullstack=1;
Line 898 sub get_all_text {	Line 1055 sub get_all_text {
while (($depth >=0) && ($token = $$pars[-1]->get_token)) {	while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);	#&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->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|($token->[0] eq 'D')) {
$result.=$token->[1];	if ($token->[2]) {
	$result.='<![CDATA['.$token->[1].']]>';
	} else {
	$result.=$token->[1];
	}
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ($token->[1] =~ /^$tag$/i) { $depth++; }	if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
$result.=$token->[4];	$result.=$token->[4];
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ( $token->[1] =~ /^$tag$/i) { $depth--; }	if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; }
#skip sending back the last end tag	#skip sending back the last end tag
if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {	if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
my $string=	my $string=
Line 936 sub get_all_text {	Line 1097 sub get_all_text {
#never found the end tag ran out of text, throw error send back blank	#never found the end tag ran out of text, throw error send back blank
&error('Never found end tag for <'.$tag.	&error('Never found end tag for <'.$tag.
'> current string <pre>'.	'> current string <pre>'.
&HTML::Entities::encode($result).	&HTML::Entities::encode($result,'<>&"').
'</pre>');	'</pre>');
if ($gotfullstack) {	if ($gotfullstack) {
my $newstring='</'.$tag.'>'.$result;	my $newstring='</'.$tag.'>'.$result;
Line 950 sub get_all_text {	Line 1111 sub get_all_text {
#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");	#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|	if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|
($token->[0] eq 'D')) {	($token->[0] eq 'D')) {
$result.=$token->[1];	if ($token->[2]) {
	$result.='<![CDATA['.$token->[1].']]>';
	} else {
	$result.=$token->[1];
	}
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ( $token->[1] =~ /^$tag$/i) {	if ( $token->[1] =~ /^\Q$tag\E$/i) {
$$pars[-1]->unget_token($token); last;	$$pars[-1]->unget_token($token); last;
} else {	} else {
$result.=$token->[4];	$result.=$token->[4];
}	}
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$result.=$token->[2];	$result.=$token->[2];
}	}
Line 978 sub get_all_text {	Line 1143 sub get_all_text {
sub newparser {	sub newparser {
my ($parser,$contentref,$dir) = @_;	my ($parser,$contentref,$dir) = @_;
push (@$parser,HTML::LCParser->new($contentref));	push (@$parser,HTML::LCParser->new($contentref));
$$parser['-1']->xml_mode('1');	$$parser[-1]->xml_mode(1);
	$$parser[-1]->marked_sections(1);
if ( $dir eq '' ) {	if ( $dir eq '' ) {
push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);	push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
} else {	} else {
Line 993 sub parstring {	Line 1159 sub parstring {
unless ($_=~/\W/) {	unless ($_=~/\W/) {
my $val=$token->[2]->{$_};	my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\\"\'])/\\$1/g;	$val =~ s/([\%\@\\\"\'])/\\$1/g;
	$val =~ s/(\$[^{a-zA-Z_])/\\$1/g;
	$val =~ s/(\$)$/\\$1/;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
if ($val !~ m/^\s*\$[a-z_]/i) { $val =~ s/\$/\\\$/g; }
$temp .= "my \$$_=\"$val\";";	$temp .= "my \$$_=\"$val\";";
}	}
}	}
return $temp;	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 {	sub writeallows {
unless ($#extlinks>=0) { return; }	unless ($#extlinks>=0) { return; }
my $thisurl='/res/'.&Apache::lonnet::declutter(shift);	my $thisurl = &Apache::lonnet::clutter(shift);
if ($ENV{'httpref.'.$thisurl}) {	if ($env{'httpref.'.$thisurl}) {
$thisurl=$ENV{'httpref.'.$thisurl};	$thisurl=$env{'httpref.'.$thisurl};
}	}
my $thisdir=$thisurl;	my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;	$thisdir=~s/\/[^\/]+$//;
Line 1038 sub afterburn {	Line 1213 sub afterburn {
my $result=shift;	my $result=shift;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['highlight','anchor','link']);	['highlight','anchor','link']);
if ($ENV{'form.highlight'}) {	if ($env{'form.highlight'}) {
foreach (split(/\,/,$ENV{'form.highlight'})) {	foreach (split(/\,/,$env{'form.highlight'})) {
my $anchorname=$_;	my $anchorname=$_;
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;	$result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs;
}	}
}	}
if ($ENV{'form.link'}) {	if ($env{'form.link'}) {
foreach (split(/\,/,$ENV{'form.link'})) {	foreach (split(/\,/,$env{'form.link'})) {
my ($anchorname,$linkurl)=split(/\>/,$_);	my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;	$result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
}	}
}	}
if ($ENV{'form.anchor'}) {	if ($env{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};	my $anchorname=$env{'form.anchor'};
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;	$result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
$result.=(<<"ENDSCRIPT");	$result.=(<<"ENDSCRIPT");
<script type="text/javascript">	<script type="text/javascript">
document.location.hash='$anchorname';	document.location.hash='$anchorname';
Line 1082 sub storefile {	Line 1257 sub storefile {
}	}

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

</body>	</body>
</html>	</html>
SIMPLECONTENT	SIMPLECONTENT
return $filecontents;	return $filecontents;
}	}

sub createnewsty {	sub createnewsty {
Line 1114 SIMPLECONTENT	Line 1287 SIMPLECONTENT

sub inserteditinfo {	sub inserteditinfo {
my ($result,$filecontents,$filetype)=@_;	my ($result,$filecontents,$filetype)=@_;
$filecontents = &HTML::Entities::encode($filecontents);	$filecontents = &HTML::Entities::encode($filecontents,'<>&"');
# my $editheader='<a href="#editsection">Edit below</a><hr />';	# my $editheader='<a href="#editsection">Edit below</a><hr />';
my $xml_help = '';	my $xml_help = '';
	my $initialize='';
if ($filetype eq 'html') {	if ($filetype eq 'html') {
$xml_help=Apache::loncommon::helpLatexCheatsheet();	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 $cleanbut = '';
if ($filetype eq 'html') {
$cleanbut='<input type="submit" name="attemptclean" value="'.
&mt('Save and then attempt to clean HTML').'" />';
}
my $titledisplay=&display_title();	my $titledisplay=&display_title();
my %lt=&Apache::lonlocal::texthash('st' => 'Save this',	my %lt=&Apache::lonlocal::texthash('st' => 'Save this',
'vi' => 'View',	'vi' => 'View',
'ed' => 'Edit');	'ed' => 'Edit');
my $buttons=(<<BUTTONS);	my $buttons=(<<BUTTONS);
$cleanbut	$cleanbut
<input type="submit" name="savethisfile" value="$lt{'st'}" />	<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
<input type="submit" name="viewmode" value="$lt{'vi'}" />	<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
BUTTONS	BUTTONS
	$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
	$buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
	$initialize
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post">	<form method="post" name="xmledit">
$xml_help	$xml_help
<input type="hidden" name="editmode" value="$lt{'ed'}" />	<input type="hidden" name="editmode" value="$lt{'ed'}" />
$buttons<br />	$buttons<br />
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>	<textarea style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
<br />$buttons	<br />$buttons
<br />	<br />
</form>	</form>
$titledisplay	$titledisplay
	</body>
ENDFOOTER	ENDFOOTER
# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;	# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;	$result=~s/(\<\/body\>)/$editfooter/is;
Line 1153 ENDFOOTER	Line 1356 ENDFOOTER
}	}

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

my $target=&get_target();	my $target=&get_target();

$Apache::lonxml::debug=$ENV{'user.debug'};	$Apache::lonxml::debug=$env{'user.debug'};

if ($ENV{'browser.mathml'}) {	&Apache::loncommon::content_type($request,'text/html');
&Apache::loncommon::content_type($request,'text/xml');
} else {
&Apache::loncommon::content_type($request,'text/html');
}
&Apache::loncommon::no_cache($request);	&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;	$request->send_http_header;

return OK if $request->header_only;	return OK if $request->header_only;
Line 1207 sub handler {	Line 1410 sub handler {
#	#
# Edit action? Save file.	# Edit action? Save file.
#	#
unless ($ENV{'request.state'} eq 'published') {	unless ($env{'request.state'} eq 'published') {
if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {	if ($env{'form.savethisfile'}) {
if (&storefile($file,$ENV{'form.filecont'})) {	if (&storefile($file,$env{'form.filecont'})) {
$request->print("<font COLOR=\"#0000FF\">".&mt('Updated').": ".	&Apache::lonxml::info("<font COLOR=\"#0000FF\">".
&Apache::lonlocal::locallocaltime(time)." </font>");	&mt('Updated').": ".
	&Apache::lonlocal::locallocaltime(time).
	" </font>");
}	}
}	}
}	}
Line 1219 sub handler {	Line 1424 sub handler {
my $result = '';	my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);	my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents eq -1) {	if ($filecontents eq -1) {
my $bodytag=&Apache::loncommon::bodytag('File Error');	my $start_page=&Apache::loncommon::start_page('File Error');
	my $end_page=&Apache::loncommon::end_page('File Error');
my $fnf=&mt('File not found');	my $fnf=&mt('File not found');
$result=(<<ENDNOTFOUND);	$result=(<<ENDNOTFOUND);
<html>	$start_page
<head>
<title>$fnf</title>
</head>
$bodytag
<b>$fnf: $file</b>	<b>$fnf: $file</b>
</body>	$end_page
</html>
ENDNOTFOUND	ENDNOTFOUND
$filecontents='';	$filecontents='';
if ($ENV{'request.state'} ne 'published') {	if ($env{'request.state'} ne 'published') {
if ($filetype eq 'sty') {	if ($filetype eq 'sty') {
$filecontents=&createnewsty();	$filecontents=&createnewsty();
} else {	} else {
$filecontents=&createnewhtml();	$filecontents=&createnewhtml();
}	}
$ENV{'form.editmode'}='Edit'; #force edit mode	$env{'form.editmode'}='Edit'; #force edit mode
}	}
} else {	} else {
unless ($ENV{'request.state'} eq 'published') {	unless ($env{'request.state'} eq 'published') {
if ($ENV{'form.attemptclean'}) {	if ($filecontents=~/BEGIN LON-CAPA Internal/) {
$filecontents=&htmlclean($filecontents,1);	&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	# we are in construction space, see if edit mode forced
&Apache::loncommon::get_unprocessed_cgi	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
($ENV{'QUERY_STRING'},['editmode']);	['editmode']);
}	}
if (!$ENV{'form.editmode'} \|\| $ENV{'form.viewmode'}) {	if (!$env{'form.editmode'} \|\| $env{'form.viewmode'}) {
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,	$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
'',%mystyle);	'',%mystyle);
	undef($Apache::lonhomework::parsing_a_task);
	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
	['rawmode']);
	if ($env{'form.rawmode'}) { $result = $filecontents; }
}	}
}	}

#	#
# Edit action? Insert editing commands	# Edit action? Insert editing commands
#	#
unless ($ENV{'request.state'} eq 'published') {	unless ($env{'request.state'} eq 'published') {
if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {	if ($env{'form.editmode'} && (!($env{'form.viewmode'}))) {
my $displayfile=$request->uri;	my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;	$displayfile=~s/^\/[^\/]*//;
$result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.	my %options = ();
'</h3></body></html>';	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);	$result=&inserteditinfo($result,$filecontents,$filetype);
}	}
}	}
if ($filetype eq 'html') { writeallows($request->uri); }	if ($filetype eq 'html') { &writeallows($request->uri); }


	&Apache::lonxml::add_messages(\$result);
$request->print($result);	$request->print($result);

return OK;	return OK;
Line 1279 ENDNOTFOUND	Line 1492 ENDNOTFOUND

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

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

	sub 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 {	sub error {
$errorcount++;	$errorcount++;
if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {	if ( &show_error_warn_msg() ) {
# If printing in construction space, put the error inside <pre></pre>	# If printing in construction space, put the error inside <pre></pre>
print "<b>ERROR:</b>".join("\n",@_)."\n";	push(@Apache::lonxml::error_messages,
} else {	$Apache::lonxml::warnings_error_header.
print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";	"<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");
#notify author	$Apache::lonxml::warnings_error_header='';
&Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));	} else {
#notify course	my $errormsg;
if ( $ENV{'request.course.id'} ) {	my ($symb)=&Apache::lonnet::symbread();
my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);	if ( !$symb ) {
my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});	#public or browsers
foreach (keys %users) {	$errormsg=&mt("An error occured while processing this resource. The author has been notified.");
my ($user,$domain) = split(/:/, $_);	}
&Apache::lonmsg::user_normal_msg($user,$domain,	my $msg = join('<br />',@_);
"Error [$declutter]",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 />");
}	}

#FIXME probably shouldn't have me get everything forever.
&Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
}
}	}

sub warning {	sub warning {
$warningcount++;	$warningcount++;

if ($ENV{'form.grade_target'} ne 'tex') {	if ($env{'form.grade_target'} ne 'tex') {
if ($ENV{'request.state'} eq 'construct' \|\| $Apache::lonxml::debug) {	if ( &show_error_warn_msg() ) {
print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";	push(@Apache::lonxml::warning_messages,
}	$Apache::lonxml::warnings_error_header.
}	"<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
	$Apache::lonxml::warnings_error_header='';
	}
	}
	}

	sub info {
	if ($env{'form.grade_target'} ne 'tex'
	&& $env{'request.state'} eq 'construct') {
	push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n");
	}
	}

	sub message_location {
	return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
	}

	sub add_messages {
	my ($msg)=@_;
	my $result=join(' ',
	@Apache::lonxml::info_messages,
	@Apache::lonxml::error_messages,
	@Apache::lonxml::warning_messages);
	undef(@Apache::lonxml::info_messages);
	undef(@Apache::lonxml::error_messages);
	undef(@Apache::lonxml::warning_messages);
	$$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
	$$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
}	}

sub get_param {	sub get_param {
Line 1338 sub get_param {	Line 1623 sub get_param {
if ( ! $context ) { $context = -1; }	if ( ! $context ) { $context = -1; }
my $args ='';	my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }	if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
	if ( ! $Apache::lonxml::usestyle ) {
	$args=$Apache::lonxml::style_values.$args;
	}
if ( ! $args ) { return undef; }	if ( ! $args ) { return undef; }
if ( $case_insensitive ) {	if ( $case_insensitive ) {
if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {	if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
Line 1361 sub get_param_var {	Line 1649 sub get_param_var {
if ( ! $context ) { $context = -1; }	if ( ! $context ) { $context = -1; }
my $args ='';	my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }	if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
	if ( ! $Apache::lonxml::usestyle ) {
	$args=$Apache::lonxml::style_values.$args;
	}
&Apache::lonxml::debug("Args are $args param is $param");	&Apache::lonxml::debug("Args are $args param is $param");
if ($case_insensitive) {	if ($case_insensitive) {
if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {	if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {
Line 1369 sub get_param_var {	Line 1660 sub get_param_var {
} elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }	} elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }
my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'	my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
&Apache::lonxml::debug("first run is $value");	&Apache::lonxml::debug("first run is $value");
if ($value =~ /^[\$\@\%]\w+$/) {	if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
&Apache::lonxml::debug("doing second");	&Apache::lonxml::debug("doing second");
my @result=&Apache::run::run("return $value",$safeeval,1);	my @result=&Apache::run::run("return $value",$safeeval,1);
if (!defined($result[0])) {	if (!defined($result[0])) {
Line 1456 sub helpinfo {	Line 1747 sub helpinfo {
sub whichuser {	sub whichuser {
my ($passedsymb)=@_;	my ($passedsymb)=@_;
my ($symb,$courseid,$domain,$name,$publicuser);	my ($symb,$courseid,$domain,$name,$publicuser);
if (defined($ENV{'form.grade_symb'})) {	if (defined($env{'form.grade_symb'})) {
my $tmp_courseid=$ENV{'form.grade_courseid'};	my ($tmp_courseid)=
my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);	&Apache::loncommon::get_env_multiple('form.grade_courseid');
if ($allowed) {	my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
$symb=$ENV{'form.grade_symb'};	if (!$allowed &&
$courseid=$ENV{'form.grade_courseid'};	exists($env{'request.course.sec'}) &&
$domain=$ENV{'form.grade_domain'};	$env{'request.course.sec'} !~ /^\s*$/) {
$name=$ENV{'form.grade_username'};	$allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.
}	'/'.$env{'request.course.sec'});
} else {
if (!$passedsymb) {
$symb=&Apache::lonnet::symbread();
} else {
$symb=$passedsymb;
}	}
$courseid=$ENV{'request.course.id'};	if ($allowed) {
$domain=$ENV{'user.domain'};	($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');
$name=$ENV{'user.name'};	$courseid=$tmp_courseid;
if ($name eq 'public' && $domain eq 'public') {	($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');
if (!defined($ENV{'form.username'})) {	($name)=&Apache::loncommon::get_env_multiple('form.grade_username');
$ENV{'form.username'}.=time.rand(10000000);	return ($symb,$courseid,$domain,$name,$publicuser);
}	}
$name.=$ENV{'form.username'};	}
	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);	return ($symb,$courseid,$domain,$name,$publicuser);
}	}

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

Removed from v.1.294
changed lines
	Added in v.1.409