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.366 and 1.462

version 1.366, 2005/03/17 13:56:32	version 1.462, 2007/10/08 09:20:22
Line 40	Line 40

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

sub register {	sub register {
my ($space,@taglist) = @_;	my ($space,@taglist) = @_;
Line 81 use Apache::languagetags();	Line 83 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();
use Apache::lonmsg();	use Apache::lonmsg();
use Apache::loncacc();	use Apache::loncacc();
	use Apache::lonmaxima();
use Apache::lonlocal;	use Apache::lonlocal;

#================================================== Main subroutine: xmlparse	#==================================== Main subroutine: xmlparse

#debugging control, to turn on debugging modify the correct handler	#debugging control, to turn on debugging modify the correct handler

$Apache::lonxml::debug=0;	$Apache::lonxml::debug=0;

# keeps count of the number of warnings and errors generated in a parse	# keeps count of the number of warnings and errors generated in a parse
Line 122 $evaluate = 1;	Line 127 $evaluate = 1;
# stores the list of active tag namespaces	# stores the list of active tag namespaces
@namespace=();	@namespace=();

# has the dynamic menu been updated to know about this resource	# stores all Scrit Vars displays for later showing
$Apache::lonxml::registered=0;	my @script_var_displays=();

# a pointer the the Apache request object	# a pointer the the Apache request object
$Apache::lonxml::request='';	$Apache::lonxml::request='';
Line 132 $Apache::lonxml::request='';	Line 137 $Apache::lonxml::request='';
$Apache::lonxml::counter=1;	$Apache::lonxml::counter=1;
$Apache::lonxml::counter_changed=0;	$Apache::lonxml::counter_changed=0;

	# Part counter hash. In analysis mode, the
	# problems can use this to record which parts increment the counter
	# by how much. The counter subs will maintain this hash via
	# their optional part parameters. Note that the assumption is that
	# analysis is done in one request and therefore it is not necessary to
	# save this information request-to-request.


	%Apache::lonxml::counters_per_part = ();

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

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

sub xmlbegin {	# Control whether or not LaTeX symbols should be substituted for their
my ($style)=@_;	# \ style equivalents...this may be turned off e.g. in an verbatim
my $output='';	# environment.
@htmlareafields=();
if ($ENV{'browser.mathml'}) {	$Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on.
$output='<?xml version="1.0"?>'
#.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"	sub enable_LaTeX_substitutions {
# .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '	$Apache::lonxml::substitute_LaTeX_symbols = 1;
	}
# .'<!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">] >'	sub disable_LaTeX_substitutions {
.'<!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">'	$Apache::lonxml::substitute_LaTeX_symbols = 0;
.'<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 {	sub xmlend {
my ($target,$parser)=@_;	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];
}	}
my $discussion;	my $discussion;
&Apache::loncommon::get_unprocessed_cgi	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
($ENV{'query_string'},['LONCAPA_INTERNAL_no_discussion']);	['LONCAPA_INTERNAL_no_discussion']);
if (! exists($ENV{'form.LONCAPA_INTERNAL_no_discussion'}) \|\|	if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) \|\|
$ENV{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {	$env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') {
$discussion=&Apache::lonfeedback::list_discussion($mode,$status);	$discussion=&Apache::lonfeedback::list_discussion($mode,$status);
}	}
if ($target eq 'tex') {	if ($target eq 'tex') {
$discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';	$discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>';
&Apache::lonxml::newparser($parser,\$discussion,'');	&Apache::lonxml::newparser($parser,\$discussion,'');
return '';	return '';
} else {
return $discussion.&Apache::loncommon::endbodytag();
}	}

	return $discussion;
}	}

sub tokeninputfield {	sub tokeninputfield {
Line 249 sub maketoken {	Line 256 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 261 sub printtokenheader {	Line 268 sub printtokenheader {
my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;	my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_;
unless ($token) { return ''; }	unless ($token) { return ''; }

my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();	my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser();
unless ($tsymb) {	unless ($tsymb) {
$tsymb=$symb;	$tsymb=$symb;
}	}
Line 271 sub printtokenheader {	Line 278 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 287 sub printtokenheader {	Line 288 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 295 sub printtokenheader {	Line 296 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 320 sub xmlparse {	Line 309 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 328 sub xmlparse {	Line 318 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) {
foreach my $file (split(',',$bodytext)) {	foreach my $file (split(',',$bodytext)) {
my $location=&Apache::lonnet::filelocation('',$file);	my $location=&Apache::lonnet::filelocation('',$file);
Line 341 sub xmlparse {	Line 331 sub xmlparse {
}	}
}	}
}	}
} elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) {	} elsif ($env{'construct.style'}
my $location=&Apache::lonnet::filelocation('',$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,
&Apache::style::styleparser($target,$styletext));	&Apache::style::styleparser($target,$styletext));
}	}
}	}
#&printalltags();	#&printalltags();
my @pars = ();	my @pars = ();
my $pwd=$ENV{'request.filename'};	my $pwd=$env{'request.filename'};
$pwd =~ s:/[^/]*$::;	$pwd =~ s:/[^/]*$::;
&newparser(\@pars,\$content_file_string,$pwd);	&newparser(\@pars,\$content_file_string,$pwd);

Line 367 sub xmlparse {	Line 358 sub xmlparse {
&initdepth();	&initdepth();
&init_alarm();	&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 (@stack) {
&writeallows($ENV{'request.uri'});	&warning("At end of file some tags were still left unclosed, ".
	'<tt><'.join('></tt>, <tt><',reverse(@stack)).
	'></tt>');
	}
	if ($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() }
if ($ENV{'form.return_only_error_and_warning_counts'}) {
	&clean_safespace($safeeval);

	if (@script_var_displays) {
	$finaloutput .= join('',@script_var_displays);
	undef(@script_var_displays);
	}

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

sub htmlclean {
my ($raw,$full)=@_;
# Take care of CRLF etc

$raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs;
$raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs;
$raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs;
$raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs;

# Generate empty tags, remove wrong end tags
$raw=~s/\<(br\|hr\|img\|meta\|allow\|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis;
$raw=~s/\<\/(br\|hr\|img\|meta\|allow\|basefont)\>//gis;
unless ($full) {
$raw=~s/\<[\/]*(body\|head\|html)\>//gis;
}
# Make standard tags lowercase
foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
'table','tr','td','th','p','br','hr','img','embed','font',
'a','strong','center','title','basefont','li','ol','ul',
'input','select','form','option','script','pre') {
$raw=~s/\<$_\s*\>/\<$_\>/gis;
$raw=~s/\<\/$_\s*\>/<\/$_\>/gis;
$raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis;
}
return $raw;
}

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/\\/\$\\backslash\$/g; # \ -> $\backslash$ per LaTex line by line pg 10.
$string =~ s/(\$\|%\|\{\|\})/\\$1/g;	$string =~ s/(\$\|%\|\{\|\})/\\$1/g;
$string =~ s/_/ /g;
$string=&Apache::lonprintout::character_chart($string);	$string=&Apache::lonprintout::character_chart($string);
# any & or # leftover should be safe to just escape	# any & or # leftover should be safe to just escape
$string=~s/([^\\])\&/$1\\\&/g;	$string=~s/([^\\])\&/$1\\\&/g;
$string=~s/([^\\])\#/$1\\\#/g;	$string=~s/([^\\])\#/$1\\\#/g;
	$string =~ s/_/\\_/g; # _ -> \_
	$string =~ s/\^/\\\^{}/g; # ^ -> \^{}
} else {	} else {
$string=~s/\\/\\ensuremath{\\backslash}/g;	$string=~s/\\/\\ensuremath{\\backslash}/g;
$string=~s/([^\\]\|^)\%/$1\\\%/g;	$string=~s/\\\%\|\%/\\\%/g;
$string=~s/([^\\]\|^)\$/$1\\\$/g;	$string=~s/\\{\|{/\\{/g;
$string=~s/([^\\])\_/$1\\_/g;	$string=~s/\\}\|}/\\}/g;
$string=~s/\$\$/\$\\\$/g;	$string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g;
$string=~s/\_\_/\_\\\_/g;	$string=~s/\\\$\|\$/\\\$/g;
$string=~s/\#\#/\#\\\#/g;	$string=~s/\\\_\|\_/\\\_/g;
$string=~s/([^\\]\|^)(\~\|\^)/$1\\$2\\strut /g;	$string=~s/([^\\]\|^)(\~\|\^)/$1\\$2\\strut /g;
$string=~s/(>\|<)/\\ensuremath\{$1\}/g; #more or less	$string=~s/(>\|<)/\\ensuremath\{$1\}/g; #more or less
$string=&Apache::lonprintout::character_chart($string);	$string=&Apache::lonprintout::character_chart($string);
# any & or # leftover should be safe to just escape	# any & or # leftover should be safe to just escape
$string=~s/([^\\]\|^)\&/$1\\\&/g;	$string=~s/\\\&\|\&/\\\&/g;
$string=~s/([^\\]\|^)\#/$1\\\#/g;	$string=~s/\\\#\|\#/\\\#/g;
$string=~s/\\|/\$\\mid\$/g;	$string=~s/\\|/\$\\mid\$/g;
#single { or } How to escape?	#single { or } How to escape?
}	}
Line 438 sub latex_special_symbols {	Line 423 sub latex_special_symbols {
}	}

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 552 sub inner_xmlparse {	Line 538 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);
}	}
Line 581 sub callsub {	Line 572 sub callsub {
}	}

my $deleted=0;	my $deleted=0;
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
if (($token->[0] eq 'S') && ($target eq 'modified')) {	if (($token->[0] eq 'S') && ($target eq 'modified')) {
$deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,	$deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
Line 617 sub callsub {	Line 607 sub callsub {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$currentstring = &Apache::edit::tag_end($target,$token);	$currentstring = &Apache::edit::tag_end($target,$token);
}	}
} elsif ($target eq 'modified') {	}
	}
	if ($target eq 'modified' && $nodefault eq '') {
	if ($currentstring eq '') {
	if ($token->[0] eq 'S') {
	$currentstring = $token->[4];
	} elsif ($token->[0] eq 'E') {
	$currentstring = $token->[2];
	} else {
	$currentstring = $token->[2];
	}
	}
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
$currentstring = $token->[4];	$currentstring.=&Apache::edit::handle_insert();
$currentstring.=&Apache::edit::handle_insert();
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$currentstring = $token->[2];	$currentstring.=&Apache::edit::handle_insertafter($token->[1]);
$currentstring.=&Apache::edit::handle_insertafter($token->[1]);
} else {
$currentstring = $token->[2];
}	}
}
}	}
}	}
use strict 'refs';	use strict 'refs';
Line 638 sub callsub {	Line 634 sub callsub {
sub setup_globals {	sub setup_globals {
my ($request,$target)=@_;	my ($request,$target)=@_;
$Apache::lonxml::request=$request;	$Apache::lonxml::request=$request;
$Apache::lonxml::registered = 0;
@Apache::lonxml::htmlareafields=();
$errorcount=0;	$errorcount=0;
$warningcount=0;	$warningcount=0;
$Apache::lonxml::default_homework_loaded=0;	$Apache::lonxml::default_homework_loaded=0;
$Apache::lonxml::usestyle=1;	$Apache::lonxml::usestyle=1;
&init_counter();	&init_counter();
	&clear_bubble_lines_for_part();
@Apache::lonxml::pwd=();	@Apache::lonxml::pwd=();
@Apache::lonxml::extlinks=();	@Apache::lonxml::extlinks=();
	@script_var_displays=();
@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::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 661 sub setup_globals {	Line 658 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 690 sub setup_globals {	Line 687 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,	$safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
'&chem_standard_order');	'&chem_standard_order');
	$safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status');

	$safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval');
	$safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check');
	$safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval,
	'&maxima_cas_formula_fix');

	$safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval,
	'&capa_formula_fix');

$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');	$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');	$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
Line 744 sub init_safespace {	Line 755 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 772 sub init_safespace {	Line 813 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::loncommon::languages,$safeeval,'&languages');
$safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');	$safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');	$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
	$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS');
	$safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS');
$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');	$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');
	# use Data::Dumper;
	# $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper');
#need to inspect this class of ops	#need to inspect this class of ops
# $safeeval->deny(":base_orig");	# $safeeval->deny(":base_orig");
$safeeval->permit("require");	$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::lonnet::whichuser();
	$rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
	my $safeinit = '$external::randomseed="'.$rndseed.'";';
	&Apache::lonxml::debug("Setting rndseed to $rndseed");
	&Apache::run::run($safeinit,$safeeval);
}	}

sub default_homework_load {	sub default_homework_load {
Line 835 sub startredirection {	Line 913 sub startredirection {

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--;
Line 844 sub endredirection {	Line 922 sub endredirection {
}	}
pop @Apache::lonxml::outputstack;	pop @Apache::lonxml::outputstack;
}	}
	sub in_redirection {
	return ($Apache::lonxml::redirection > 0)
	}

sub end_tag {	sub end_tag {
my ($tagstack,$parstack,$token)=@_;	my ($tagstack,$parstack,$token)=@_;
Line 854 sub end_tag {	Line 935 sub end_tag {

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


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

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

sub decreasedepth {	sub decreasedepth {
my ($token) = @_;	my ($token) = @_;
$Apache::lonxml::depth--;	if ( $#Apache::lonxml::depthcounter == -1) {
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {	&Apache::lonxml::warning(&mt("Missing tags, unable to properly run file."));
$#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';
}	}
	$Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter);

my ($timer,$time);	my ($timer,$time);
if ($Apache::lonxml::debug eq "1") {	if ($Apache::lonxml::debug eq "1") {
$timer=pop(@timers);	$timer=pop(@timers);
$time=&tv_interval($lasttime);	$time=&tv_interval($lasttime);
$lasttime=[&gettimeofday()];	$lasttime=[&gettimeofday()];
}	}
my $spacing=' 'x$Apache::lonxml::depth;	my $spacing=' 'x($#Apache::lonxml::depthcounter);
my $curdepth=join('_',@Apache::lonxml::depthcounter);	$Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n");	# &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer));
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";	#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 =~ /([._]\|[^\w\d\s[:punct:]])/) {
	&error(&mt("ID "[_1]" contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",'<tt>'.$id.'</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)= @_;
Line 910 sub get_all_text_unbalanced {	Line 1000 sub get_all_text_unbalanced {
$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]) {
	$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') {
Line 928 sub get_all_text_unbalanced {	Line 1022 sub get_all_text_unbalanced {
}	}
}	}
return $result	return $result

}	}

	#########################################################################
	# #
	# bubble line counter management #
	# #
	#########################################################################

	=pod

	For bubble grading mode and exam bubble printing mode, the tracking of
	the current 'bubble line number' is stored in the %env element
	'form.counter', and is modifed and handled by the following routines.

	The value of it is stored in $Apache:lonxml::counter when live and
	stored back to env after done.

	=item &increment_counter($increment);

	Increments the internal counter environment variable a specified amount

	Optional Arguments:
	$increment - amount to increment by (defaults to 1)
	Also 1 if the value is negative or zero.
	$part_id - optional part id.. during analysis, this
	indicates whic part of a problem is being
	counted.

	=cut

sub increment_counter {	sub increment_counter {
my ($increment) = @_;	my ($increment, $part_id) = @_;
if (defined($increment) && $increment gt 0) {	if (!defined($increment) \|\| $increment le 0) {
$Apache::lonxml::counter+=$increment;	$increment = 1;
} else {	}
$Apache::lonxml::counter++;	$Apache::lonxml::counter += $increment;

	# If the caller supplied the part_id parameter,
	# Maintain its counter.. creating if necessary.

	if(defined($part_id)) {
	if (!defined($Apache::lonxml::counters_per_part{$part_id})) {
	$Apache::lonxml::counters_per_part{$part_id} = 0;
	}
	$Apache::lonxml::counters_per_part{$part_id} += $increment;
	my $new_value = $Apache::lonxml::counters_per_part{$part_id};
}	}

$Apache::lonxml::counter_changed=1;	$Apache::lonxml::counter_changed=1;
}	}

	=pod

	=item &init_counter($increment);

	Initialize the internal counter environment variable

	=cut

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 952 sub init_counter {	Line 1097 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(undef,undef,1);
	$state = $env{'form.counter'};
	}

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

	=pod

	=item bubble_lines_for_part(part_id)

	Returns the number of lines required to get a response for
	$part_id (this is just $Apache::lonxml::counters_per_part{$part_id}

	=cut

	sub bubble_lines_for_part {
	my ($part_id) = @_;

	if (!defined($Apache::lonxml::counters_per_part{$part_id})) {
	return 0;
	} else {
	return $Apache::lonxml::counters_per_part{$part_id};
	}

	}

	=pod

	=item clear_bubble_lines_for_part

	Clears the hash of bubble lines per part. If a caller
	needs to analyze several resources this should be called between
	resources to reset the hash for each problem being analyzed.

	=cut

	sub clear_bubble_lines_for_part {
	undef(%Apache::lonxml::counters_per_part);
	}

	=pod

	=item set_bubble_lines(part_id, value)

	If there is a problem part, that for whatever reason
	requires bubble lines that are not
	the same as the counter increment, it can call this sub during
	analysis to set its hash value explicitly.

	=cut

	sub set_bubble_lines {
	my ($part_id, $value) = @_;

	$Apache::lonxml::counters_per_part{$part_id} = $value;
	}

	=pod

	=item get_bubble_line_hash

	Returns the current bubble line hash. This is assumed to
	be small so we return a copy


	=cut

	sub get_bubble_line_hash {
	return %Apache::lonxml::counters_per_part;
	}


	#--------------------------------------------------

sub get_all_text {	sub get_all_text {
my($tag,$pars,$style)= @_;	my($tag,$pars,$style)= @_;
my $gotfullstack=1;	my $gotfullstack=1;
Line 976 sub get_all_text {	Line 1216 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') {
Line 1028 sub get_all_text {	Line 1272 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') {
Line 1066 sub newparser {	Line 1314 sub newparser {
}	}

sub parstring {	sub parstring {
my ($token) = @_;	my ($token) = @_;
my $temp='';	my (@vars,@values);
foreach (@{$token->[3]}) {	foreach my $attr (@{$token->[3]}) {
unless ($_=~/\W/) {	if ($attr!~/\W/) {
my $val=$token->[2]->{$_};	my $val=$token->[2]->{$attr};
$val =~ s/([\%\@\\\"\'])/\\$1/g;	$val =~ s/([\%\@\\\"\'])/\\$1/g;
$val =~ s/(\$[^{a-zA-Z_])/\\$1/g;	$val =~ s/(\$[^\{a-zA-Z_])/\\$1/g;
$val =~ s/(\$)$/\\$1/;	$val =~ s/(\$)$/\\$1/;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";";	push(@vars,"\$$attr");
	push(@values,"\"$val\"");
	}
	}
	my $var_init =
	(@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');'
	: '';
	return $var_init;
	}

	sub extlink {
	my ($res,$exact)=@_;
	if (!$exact) {
	$res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res);
}	}
}	push(@Apache::lonxml::extlinks,$res)
return $temp;
}	}

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/\/[^\/]+$//;
my %httpref=();	my %httpref=();
foreach (@extlinks) {	foreach (@extlinks) {
$httpref{'httpref.'.	$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;	&Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl;
}	}
@extlinks=();	@extlinks=();
&Apache::lonnet::appenv(%httpref);	&Apache::lonnet::appenv(%httpref);
Line 1111 sub do_registered_ssi {	Line 1371 sub do_registered_ssi {
&Apache::lonnet::ssi($url,%form);	&Apache::lonnet::ssi($url,%form);
}	}
}	}

	sub add_script_result {
	my ($display) = @_;
	push(@script_var_displays, $display);
	}

#	#
# Afterburner handles anchors, highlights and links	# Afterburner handles anchors, highlights and links
#	#
Line 1118 sub afterburn {	Line 1384 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/(\Q$matchthis\E)/\<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/(\Q$matchthis\E)/\<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/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;	$result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
Line 1165 sub createnewhtml {	Line 1431 sub createnewhtml {
my $title=&mt('Title of document goes here');	my $title=&mt('Title of document goes here');
my $body=&mt('Body of document goes here');	my $body=&mt('Body of document goes here');
my $filecontents=(<<SIMPLECONTENT);	my $filecontents=(<<SIMPLECONTENT);
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml/11/DTD/xhtml11.dtd">
<html>	<html>
<head>	<head>
<title>$title</title>	<title>$title</title>
Line 1192 SIMPLECONTENT	Line 1457 SIMPLECONTENT


sub inserteditinfo {	sub inserteditinfo {
my ($result,$filecontents,$filetype)=@_;	my ($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='';	my $initialize='';
if ($filetype eq 'html') {	my $textarea_id = 'filecont';
my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();	my ($add_to_onload, $add_to_onresize);
$initialize=&Apache::lonhtmlcommon::htmlareaheaders().	my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
&Apache::lonhtmlcommon::spellheader();	$initialize=&Apache::lonhtmlcommon::spellheader();
if (!&Apache::lonhtmlcommon::htmlareablocked() &&	if ($filetype eq 'html'
&Apache::lonhtmlcommon::htmlareabrowser()) {	&& (!&Apache::lonhtmlcommon::htmlareablocked() &&
$initialize.=(<<FULLPAGE);	&Apache::lonhtmlcommon::htmlareabrowser())) {
	$textarea_id .= '_htmlarea';
	$initialize.=(<<FULLPAGE);
<script type="text/javascript">	<script type="text/javascript">
$addbuttons	$addbuttons

Line 1213 $addbuttons	Line 1480 $addbuttons
var editor=new HTMLArea("filecont",config);	var editor=new HTMLArea("filecont",config);
editor.registerPlugin(FullPage);	editor.registerPlugin(FullPage);
editor.generate();	editor.generate();
	setTimeout(
	function () {
	HTMLArea._addEvents(editor._doc,
	["keypress","mousedown"], unClean);
	editor._iframe.id = '$textarea_id';
	resize_textarea('$textarea_id','LC_aftertextarea');
	},300);
}	}
</script>	</script>
FULLPAGE	FULLPAGE
} else {	} else {
$initialize.=(<<FULLPAGE);	$initialize.=(<<FULLPAGE);
<script type="text/javascript">	<script type="text/javascript">
$addbuttons	$addbuttons
function initDocument() {	function initDocument() {
	resize_textarea('$textarea_id','LC_aftertextarea');
}	}
</script>	</script>
FULLPAGE	FULLPAGE
}
$result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;
$xml_help=&Apache::loncommon::helpLatexCheatsheet();
}	}
my $cleanbut = '';
	$add_to_onload = 'initDocument();';
	$add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');";

if ($filetype eq 'html') {	if ($filetype eq 'html') {
$cleanbut='<input type="submit" name="attemptclean" value="'.	$xml_help=&Apache::loncommon::helpLatexCheatsheet();
&mt('Save and then attempt to clean HTML').'" />';
}	}

	my $cleanbut = '';

my $titledisplay=&display_title();	my $titledisplay=&display_title();
my %lt=&Apache::lonlocal::texthash('st' => 'Save this',	my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit',
'vi' => 'View',	'vi' => 'Save and View',
	'dv' => 'Discard Edits and View',
	'un' => 'undo',
'ed' => 'Edit');	'ed' => 'Edit');
my $buttons=(<<BUTTONS);	my $buttons=(<<BUTTONS);
$cleanbut	$cleanbut
	<input type="submit" name="discardview" accesskey="d" value="$lt{'dv'}" />
	<input type="submit" name="Undo" accesskey="u" value="$lt{'un'}" /><hr />
<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />	<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />	<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
BUTTONS	BUTTONS
$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');	$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
$buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');	my $textarea_events = &Apache::edit::element_change_detection();
	my $form_events = &Apache::edit::form_change_detection();
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
$initialize	$initialize
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post" name="xmledit">	<form $form_events 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 style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>	<textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
	<div id="LC_aftertextarea">
<br />$buttons	<br />$buttons
<br />	<br />
</form>
$titledisplay	$titledisplay
	</div>
	</form>
</body>	</body>
ENDFOOTER	ENDFOOTER
# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;	return ($editfooter,$add_to_onload,$add_to_onresize);;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}	}

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 1296 sub handler {	Line 1578 sub handler {

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

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

&Apache::loncommon::content_type($request,'text/html');	&Apache::loncommon::content_type($request,'text/html');
&Apache::loncommon::no_cache($request);	&Apache::loncommon::no_cache($request);
if ($ENV{'request.state'} eq 'published') {	if ($env{'request.state'} eq 'published') {
$request->set_last_modified(&Apache::lonnet::metadata($request->uri,	$request->set_last_modified(&Apache::lonnet::metadata($request->uri,
'lastrevisiondate'));	'lastrevisiondate'));
}	}
Line 1319 sub handler {	Line 1601 sub handler {
#	#
# Edit action? Save file.	# Edit action? Save file.
#	#
unless ($ENV{'request.state'} eq 'published') {	if (!($env{'request.state'} eq 'published')) {
if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {	if ($env{'form.savethisfile'} \|\| $env{'form.viewmode'} \|\| $env{'form.Undo'}) {
if (&storefile($file,$ENV{'form.filecont'})) {	my $html_file=&Apache::lonnet::getfile($file);
&Apache::lonxml::info("<font COLOR=\"#0000FF\">".	my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'});
&mt('Updated').": ".
&Apache::lonlocal::locallocaltime(time).
" </font>");
}
}	}
}	}
my %mystyle;	my %mystyle;
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();
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 ($filecontents=~/BEGIN LON-CAPA Internal/) {	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.'));	&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.'));
}

if ($ENV{'form.attemptclean'}) {
$filecontents=&htmlclean($filecontents,1);
}	}
#	#
# 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'} \|\| $env{'form.discardview'}) {
	&Apache::structuretags::reset_problem_globals();
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,	$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
'',%mystyle);	'',%mystyle);
	# .html files may contain <problem> or <Task> need to clean
	# up if it did
	&Apache::structuretags::reset_problem_globals();
	&Apache::lonhomework::finished_parsing();
	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
	['rawmode']);
	if ($env{'form.rawmode'}) { $result = $filecontents; }
	if ($filetype eq 'sty') {
	my $controls =
	($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls()
	: '';
	my %options = ('bgcolor' => '#FFFFFF');
	$result =
	&Apache::loncommon::start_page(undef,undef,\%options).
	$controls.
	$result.
	&Apache::loncommon::end_page();
	}
}	}
}	}

#	#
# Edit action? Insert editing commands	# Edit action? Insert editing commands
#	#
unless ($ENV{'request.state'} eq 'published') {	unless ($env{'request.state'} eq 'published') {
if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {	if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'})))
	{
	my ($edit_info, $add_to_onload, $add_to_onresize)=
	&inserteditinfo($filecontents,$filetype);

my $displayfile=$request->uri;	my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;	$displayfile=~s/^\/[^\/]*//;
my $bodytag='<body bgcolor="#FFFFFF">';	my %options =
if ($ENV{'environment.remote'} eq 'off') {	('add_entries' =>
$bodytag=&Apache::loncommon::bodytag();	{'onresize' => $add_to_onresize,
	'onload' => $add_to_onload, });

	if ($env{'environment.remote'} ne 'off') {
	$options{'bgcolor'} = '#FFFFFF';
	$options{'only_body'} = 1;
}	}
$result='<html>'.$bodytag.	my $js =
	&Apache::edit::js_change_detection().
	&Apache::loncommon::resize_textarea_js();
	my $start_page = &Apache::loncommon::start_page(undef,$js,
	\%options);
	$result=$start_page.
&Apache::lonxml::message_location().'<h3>'.	&Apache::lonxml::message_location().'<h3>'.
$displayfile.	$displayfile.
'</h3></body></html>';	'</h3>'.
$result=&inserteditinfo($result,$filecontents,$filetype);	$edit_info.
	&Apache::loncommon::end_page();
}	}
}	}
if ($filetype eq 'html') { writeallows($request->uri); }	if ($filetype eq 'html') { &writeallows($request->uri); }


&Apache::lonxml::add_messages(\$result);	&Apache::lonxml::add_messages(\$result);
$request->print($result);	$request->print($result);
Line 1403 ENDNOTFOUND	Line 1706 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 1418 sub debug {	Line 1721 sub debug {
if ($Apache::lonxml::debug eq "1") {	if ($Apache::lonxml::debug eq "1") {
$\|=1;	$\|=1;
my $request=$Apache::lonxml::request;	my $request=$Apache::lonxml::request;
if (!$request) { $request=Apache->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");	$request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n");
#&Apache::lonnet::logthis($_[0]);	#&Apache::lonnet::logthis($_[0]);
}	}
}	}

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

sub error {	sub error {
	my @errors = @_;

$errorcount++;	$errorcount++;

	if (defined($Apache::inputtags::part)) {
	if ( @Apache::inputtags::response ) {
	push(@errors,
	&mt("This error occurred while processing response [_1] in part [_2]",
	$Apache::inputtags::response[-1],
	$Apache::inputtags::part));
	} else {
	push(@errors,
	&mt("This error occurred while processing part [_1]",
	$Apache::inputtags::part));
	}
	}

if ( &show_error_warn_msg() ) {	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>
push(@Apache::lonxml::error_messages,	push(@Apache::lonxml::error_messages,
$Apache::lonxml::warnings_error_header.	$Apache::lonxml::warnings_error_header.
"<b>ERROR:</b>".join("<br />\n",@_)."<br />\n");	"<b>ERROR:</b>".join("<br />\n",@errors)."<br />\n");
$Apache::lonxml::warnings_error_header='';	$Apache::lonxml::warnings_error_header='';
} else {	} else {
my $errormsg;	my $errormsg;
Line 1450 sub error {	Line 1774 sub error {
if ( !$symb ) {	if ( !$symb ) {
#public or browsers	#public or browsers
$errormsg=&mt("An error occured while processing this resource. The author has been notified.");	$errormsg=&mt("An error occured while processing this resource. The author has been notified.");
}	}
	my $host=$Apache::lonnet::perlvar{'lonHostID'};
	push(@errors, "The error occurred on host <tt>$host</tt>");

	my $msg = join('<br />', @errors);

#notify author	#notify author
&Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));	&Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
#notify course	#notify course
if ( $symb && $ENV{'request.course.id'} ) {	if ( $symb && $env{'request.course.id'} ) {
my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);	my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});	my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
	my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1);
	my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
	my $baseurl = &Apache::lonnet::clutter($declutter);
my @userlist;	my @userlist;
foreach (keys %users) {	foreach (keys %users) {
my ($user,$domain) = split(/:/, $_);	my ($user,$domain) = split(/:/, $_);
push(@userlist,"$user\@$domain");	push(@userlist,"$user\@$domain");
&Apache::lonmsg::user_normal_msg($user,$domain,	my $key=$declutter.'_'.$user.'_'.$domain;
"Error [$declutter]",join('<br />',@_));	my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
	[$key],
	$cdom,$cnum);
	my $now=time;
	if ($now-$lastnotified{$key}>86400) {
	my $title = &Apache::lonnet::gettitle($symb);
	my $sentmessage;
	&Apache::lonmsg::user_normal_msg($user,$domain,
	"Error [$title]",$msg,'',$baseurl,'','',
	\$sentmessage,$symb,$title,1);
	&Apache::lonnet::put('nohist_xmlerrornotifications',
	{$key => $now},
	$cdom,$cnum);
	}
}	}
if ($ENV{'request.role.adv'}) {	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));	$errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
} else {	} else {
$errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");	$errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
Line 1477 sub error {	Line 1822 sub error {
sub warning {	sub warning {
$warningcount++;	$warningcount++;

if ($ENV{'form.grade_target'} ne 'tex') {	if ($env{'form.grade_target'} ne 'tex') {
if ( &show_error_warn_msg() ) {	if ( &show_error_warn_msg() ) {
my $request=$Apache::lonxml::request;
if (!$request) { $request=Apache->request; }
push(@Apache::lonxml::warning_messages,	push(@Apache::lonxml::warning_messages,
$Apache::lonxml::warnings_error_header.	$Apache::lonxml::warnings_error_header.
"<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");	"<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n");
Line 1490 sub warning {	Line 1833 sub warning {
}	}

sub info {	sub info {
if ($ENV{'form.grade_target'} ne 'tex'	if ($env{'form.grade_target'} ne 'tex'
&& $ENV{'request.state'} eq 'construct') {	&& $env{'request.state'} eq 'construct') {
push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n");	push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n");
}	}
}	}
Line 1523 sub get_param {	Line 1866 sub get_param {
}	}
if ( ! $args ) { return undef; }	if ( ! $args ) { return undef; }
if ( $case_insensitive ) {	if ( $case_insensitive ) {
if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {	if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) {
return &Apache::run::run("{$args;".'return $'.$param.'}',	return &Apache::run::run("{$args;".'return $'.$param.'}',
$safeeval); #'	$safeeval); #'
} else {	} else {
return undef;	return undef;
}	}
} else {	} else {
if ( $args =~ /my \$\Q$param\E=\"/ ) {	if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) {
return &Apache::run::run("{$args;".'return $'.$param.'}',	return &Apache::run::run("{$args;".'return $'.$param.'}',
$safeeval); #'	$safeeval); #'
} else {	} else {
Line 1549 sub get_param_var {	Line 1892 sub get_param_var {
}	}
&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)/ei)) {
return undef;	return undef;
}	}
} elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }	} elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; }
my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'	my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
&Apache::lonxml::debug("first run is $value");	&Apache::lonxml::debug("first run is $value");
if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {	if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
Line 1568 sub get_param_var {	Line 1911 sub get_param_var {
}	}
}	}

sub register_insert {	sub register_insert_xml {
my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');	my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'}
my $i;	.'/insertlist.xml');
my $tagnum=0;	my ($tagnum,$in_help)=(0,0);
my @order;	my @alltags;
for ($i=0;$i < $#data; $i++) {	my $tag;
my $line = $data[$i];	while (my $token = $parser->get_token()) {
if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }	if ($token->[0] eq 'S') {
if ( $line =~ /TABLE/ ) { last; }	my $key;
my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);	if ($token->[1] eq 'tag') {
if ($tag) {	$tag = $token->[2]{'name'};
$insertlist{"$tagnum.tag"} = $tag;	$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.description"} = $descrip;	$insertlist{"$tag.num"} = $tagnum;
$insertlist{"$tagnum.color"} = $color;	push(@alltags,$tag);
$insertlist{"$tagnum.function"} = $function;	} elsif ($in_help && $token->[1] eq 'file') {
if (!defined($show)) { $show='yes'; }	$key = $tag.'.helpfile';
$insertlist{"$tagnum.show"}= $show;	} elsif ($in_help && $token->[1] eq 'description') {
$insertlist{"$tagnum.helpfile"} = $helpfile;	$key = $tag.'.helpdesc';
$insertlist{"$tagnum.helpdesc"} = $helpdesc;	} elsif ($token->[1] eq 'description' \|\|
$insertlist{"$tag.num"}=$tagnum;	$token->[1] eq 'color' \|\|
$tagnum++;	$token->[1] eq 'show' ) {
	$key = $tag.'.'.$token->[1];
	} elsif ($token->[1] eq 'insert_sub') {
	$key = $tag.'.function';
	} elsif ($token->[1] eq 'help') {
	$in_help=1;
	} elsif ($token->[1] eq 'allow') {
	$key = $tag.'.allow';
	}
	if (defined($key)) {
	$insertlist{$key} = $parser->get_text();
	$insertlist{$key} =~ s/(^\s\|\s$ )//gx;
	}
	} elsif ($token->[0] eq 'E') {
	if ($token->[1] eq 'tag') {
	undef($tag);
	$tagnum++;
	} elsif ($token->[1] eq 'help') {
	undef($in_help);
	}
	}
}	}
}
$i++; #skipping TABLE line	# parse the allows and ignore tags set to <show>no</show>
$tagnum = 0;	foreach my $tag (@alltags) {
for (;$i < $#data;$i++) {	next if (!exists($insertlist{"$tag.allow"}));
my $line = $data[$i];	my $allow = $insertlist{"$tag.allow"};
my ($mnemonic,@which) = split(/ +/,$line);	foreach my $element (split(',',$allow)) {
my $tag = $insertlist{"$tagnum.tag"};	$element =~ s/(^\s\|\s$ )//gx;
for (my $j=0;$j <=$#which;$j++) {	if (!exists($insertlist{"$element.show"})
if ( $which[$j] eq 'Y' ) {	\|\| $insertlist{"$element.show"} ne 'no') {
if ($insertlist{"$j.show"} ne 'no') {	push(@{ $insertlist{$tag.'.which'} },$element);
push(@{ $insertlist{"$tag.which"} },$j);	}
}	}
}
}	}
$tagnum++;	}
}
	sub register_insert {
	return &register_insert_xml(@_);
	# &dump_insertlist('2');
	}

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

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

sub description {	sub description {
my ($token)=@_;	my ($token)=@_;
my $tagnum;	my $tag = &get_tag($token);
my $tag=$token->[1];	return $insertlist{$tag.'.description'};
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	# Returns a list containing the help file, and the description
sub helpinfo {	sub helpinfo {
my ($token)=@_;	my ($token)=@_;
my $tagnum;	my $tag = &get_tag($token);
my $tag=$token->[1];	return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.helpdesc'});
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	sub get_tag {
# returns a list of $symb, $courseid, $domain, $name that is correct for	my ($token)=@_;
# calls to lonnet functions for this setup.	my $tagnum;
# - looks for form.grade_ parameters	my $tag=$token->[1];
sub whichuser {	foreach my $namespace (reverse(@Apache::lonxml::namespace)) {
my ($passedsymb)=@_;	my $testtag = $namespace.'::'.$tag;
my ($symb,$courseid,$domain,$name,$publicuser);	$tagnum = $insertlist{"$testtag.num"};
if (defined($ENV{'form.grade_symb'})) {	last if (defined($tagnum));
my ($tmp_courseid)=	}
&Apache::loncommon::get_env_multiple('form.grade_courseid');	if (!defined($tagnum)) {
my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);	$tagnum = $Apache::lonxml::insertlist{"$tag.num"};
if (!$allowed &&	}
exists($ENV{'request.course.sec'}) &&	return $insertlist{"$tagnum.tag"};
$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;	1;

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

Removed from v.1.366
changed lines
	Added in v.1.462