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.361 and 1.449

version 1.361, 2005/03/10 02:34:59	version 1.449, 2007/08/03 23:29:54
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
Line 122 $evaluate = 1;	Line 125 $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 148 $Apache::lonxml::post_evaluate=1;	Line 151 $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=&Apache::lonfeedback::list_discussion($mode,$status);	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') {	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 243 sub maketoken {	Line 244 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 255 sub printtokenheader {	Line 256 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 265 sub printtokenheader {	Line 266 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 281 sub printtokenheader {	Line 276 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 289 sub printtokenheader {	Line 284 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 314 sub xmlparse {	Line 297 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 322 sub xmlparse {	Line 306 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 335 sub xmlparse {	Line 319 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 361 sub xmlparse {	Line 346 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 432 sub latex_special_symbols {	Line 411 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 546 sub inner_xmlparse {	Line 526 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 575 sub callsub {	Line 560 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 611 sub callsub {	Line 595 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 632 sub callsub {	Line 622 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;
Line 641 sub setup_globals {	Line 629 sub setup_globals {
&init_counter();	&init_counter();
@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 655 sub setup_globals {	Line 645 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 684 sub setup_globals {	Line 674 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 738 sub init_safespace {	Line 742 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 768 sub init_safespace {	Line 802 sub init_safespace {
$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::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 829 sub startredirection {	Line 899 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 848 sub end_tag {	Line 918 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 904 sub get_all_text_unbalanced {	Line 983 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 924 sub get_all_text_unbalanced {	Line 1007 sub get_all_text_unbalanced {
return $result	return $result
}	}

	=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)

	=cut

sub increment_counter {	sub increment_counter {
my ($increment) = @_;	my ($increment) = @_;
if (defined($increment) && $increment gt 0) {	if (defined($increment) && $increment gt 0) {
Line 934 sub increment_counter {	Line 1035 sub increment_counter {
$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 946 sub init_counter {	Line 1058 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'};
	}
	}

sub get_all_text {	sub get_all_text {
my($tag,$pars,$style)= @_;	my($tag,$pars,$style)= @_;
my $gotfullstack=1;	my $gotfullstack=1;
Line 970 sub get_all_text {	Line 1109 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 1022 sub get_all_text {	Line 1165 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 1050 sub get_all_text {	Line 1197 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 1059 sub newparser {	Line 1207 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 1104 sub do_registered_ssi {	Line 1264 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 1111 sub afterburn {	Line 1277 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 1158 sub createnewhtml {	Line 1324 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 sub inserteditinfo {	Line 1357 sub inserteditinfo {
my $initialize='';	my $initialize='';
if ($filetype eq 'html') {	if ($filetype eq 'html') {
my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();	my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
$initialize=&Apache::lonhtmlcommon::htmlareaheaders().	$initialize=&Apache::lonhtmlcommon::spellheader();
&Apache::lonhtmlcommon::spellheader();
if (!&Apache::lonhtmlcommon::htmlareablocked() &&	if (!&Apache::lonhtmlcommon::htmlareablocked() &&
&Apache::lonhtmlcommon::htmlareabrowser()) {	&Apache::lonhtmlcommon::htmlareabrowser()) {
$initialize.=(<<FULLPAGE);	$initialize.=(<<FULLPAGE);
Line 1222 FULLPAGE	Line 1386 FULLPAGE
$xml_help=&Apache::loncommon::helpLatexCheatsheet();	$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 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 $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
$initialize	$initialize
<hr />	<hr />
Line 1245 $initialize	Line 1409 $initialize
$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="44" name="filecont" id="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>
Line 1258 ENDFOOTER	Line 1422 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 1289 sub handler {	Line 1453 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);
$request->set_last_modified(&Apache::lonnet::metadata($request->uri,	if ($env{'request.state'} eq 'published') {
'lastrevisiondate'));	$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 1314 sub handler {	Line 1476 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'}) {
$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'})) && (!($env{'form.discardview'})))
	{
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') {	if ($env{'environment.remote'} ne 'off') {
$bodytag=&Apache::loncommon::bodytag();	$options{'bgcolor'} = '#FFFFFF';
}	}
$result='<html>'.$bodytag.	my $start_page = &Apache::loncommon::start_page(undef,undef,
	\%options);
	$result=$start_page.
&Apache::lonxml::message_location().'<h3>'.	&Apache::lonxml::message_location().'<h3>'.
$displayfile.	$displayfile.
'</h3></body></html>';	'</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);	&Apache::lonxml::add_messages(\$result);
Line 1398 ENDNOTFOUND	Line 1555 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 1413 sub debug {	Line 1570 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 {
Line 1445 sub error {	Line 1607 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'};
	my $msg = join('<br />',(@_,"The error occurred on host <tt>$host</tt>"));
#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 1472 sub error {	Line 1652 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 1485 sub warning {	Line 1663 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 1518 sub get_param {	Line 1696 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 1544 sub get_param_var {	Line 1722 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 1563 sub get_param_var {	Line 1741 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.361
changed lines
	Added in v.1.449