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.283 and 1.356

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

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

sub register {	sub register {
my ($space,@taglist) = @_;	my ($space,@taglist) = @_;
Line 96 use Apache::style();	Line 77 use Apache::style();
use Apache::run();	use Apache::run();
use Apache::londefdef();	use Apache::londefdef();
use Apache::scripttag();	use Apache::scripttag();
	use Apache::languagetags();
use Apache::edit();	use Apache::edit();
use Apache::inputtags();	use Apache::inputtags();
use Apache::outputtags();	use Apache::outputtags();
Line 140 $evaluate = 1;	Line 122 $evaluate = 1;
# stores the list of active tag namespaces	# stores the list of active tag namespaces
@namespace=();	@namespace=();

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

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

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

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

sub xmlbegin {	sub xmlbegin {
my $output='';	my ($style)=@_;
if ($ENV{'browser.mathml'}) {	my $output='';
$output='<?xml version="1.0"?>'	@htmlareafields=();
	if ($ENV{'browser.mathml'}) {
	$output='<?xml version="1.0"?>'
.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'	.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
.'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '	.'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
.'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'	.'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '	.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
.'xmlns="http://www.w3.org/TR/REC-html40">';	.'xmlns="http://www.w3.org/TR/REC-html40">';
} else {	} else {
$output='<html>';	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
}	}
return $output;	if ($style eq 'encode') {
	$output=&HTML::Entities::encode($output,'<>&"');
	}
	return $output;
}	}

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

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

sub fontsettings() {	sub fontsettings {
my $headerstring='';	my $headerstring='';
if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {	if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
$headerstring.=	$headerstring.=
'<meta Content-Type="text/html; charset=x-mac-roman">';	'<meta Content-Type="text/html; charset=x-mac-roman" />';
} elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) {	} elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) {
$headerstring.=	$headerstring.=
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';	'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
Line 319 sub xmlparse {	Line 314 sub xmlparse {
&Apache::inputtags::initialize_inputtags();	&Apache::inputtags::initialize_inputtags();
&Apache::outputtags::initialize_outputtags();	&Apache::outputtags::initialize_outputtags();
&Apache::edit::initialize_edit();	&Apache::edit::initialize_edit();
	&Apache::londefdef::initialize_londefdef();

#	#
# do we have a course style file?	# do we have a course style file?
Line 328 sub xmlparse {	Line 324 sub xmlparse {
my $bodytext=	my $bodytext=
$ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};	$ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
if ($bodytext) {	if ($bodytext) {
my $location=&Apache::lonnet::filelocation('',$bodytext);	foreach my $file (split(',',$bodytext)) {
my $styletext=&Apache::lonnet::getfile($location);	my $location=&Apache::lonnet::filelocation('',$file);
	my $styletext=&Apache::lonnet::getfile($location);
	if ($styletext ne '-1') {
	%style_for_target = (%style_for_target,
	&Apache::style::styleparser($target,$styletext));
	}
	}
	}
	} elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) {
	my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'});
	my $styletext=&Apache::lonnet::getfile($location);
if ($styletext ne '-1') {	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 = ();
Line 366 sub xmlparse {	Line 371 sub xmlparse {

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

my $tree = HTML::TreeBuilder->new;	$raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs;
$tree->ignore_unknown(0);	$raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs;
	$raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs;
$tree->parse($raw);	$raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs;

my $output= $tree->as_HTML(undef,' ');	# Generate empty tags, remove wrong end tags
	$raw=~s/\<(br\|hr\|img\|meta\|allow\|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis;
$output=~s/\<(br\|hr\|img\|meta\|allow)(.*?)\>/\<$1$2 \/\>/gis;	$raw=~s/\<\/(br\|hr\|img\|meta\|allow\|basefont)\>//gis;
$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;
unless ($full) {	unless ($full) {
$output=~s/\<[\/]*(body\|head\|html)\>//gis;	$raw=~s/\<[\/]*(body\|head\|html)\>//gis;
}	}
	# Make standard tags lowercase
$tree = $tree->delete;	foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
	'table','tr','td','th','p','br','hr','img','embed','font',
return $output;	'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 ($where eq 'header') {	if ($where eq 'header') {
$string =~ s/(\\\|_\|\^)/ /g;	$string =~ s/(\\\|_\|\^)/ /g;
$string =~ s/(\$\|%\|\#\|&\|\{\|\})/\\$1/g;	$string =~ s/(\$\|%\|\{\|\})/\\$1/g;
$string =~ s/_/ /g;	$string =~ s/_/ /g;
	$string=&Apache::lonprintout::character_chart($string);
	# any & or # leftover should be safe to just escape
	$string=~s/([^\\])\&/$1\\\&/g;
	$string=~s/([^\\])\#/$1\\\#/g;
} else {	} else {
$string=~s/\\ /\\char92 /g;	$string=~s/\\/\\ensuremath{\\backslash}/g;
$string=~s/\^/\\char94 /g;	$string=~s/([^\\]\|^)\%/$1\\\%/g;
$string=~s/\~/\\char126 /g;	$string=~s/([^\\]\|^)\$/$1\\\$/g;
$string=~s/(&[^A-Za-z\#])/\\$1/g;	$string=~s/([^\\])\_/$1\\_/g;
$string=~s/([^&])\#/$1\\#/g;	$string=~s/\$\$/\$\\\$/g;
$string=~s/(\$\|_\|{\|})/\\$1/g;	$string=~s/\_\_/\_\\\_/g;
$string=~s/\\char92 /\\texttt{\\char92}/g;	$string=~s/\#\#/\#\\\#/g;
$string=~s/(>\|<)/\$$1\$/g; #more or less	$string=~s/([^\\]\|^)(\~\|\^)/$1\\$2\\strut /g;
if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit	$string=~s/(>\|<)/\\ensuremath\{$1\}/g; #more or less
if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space	$string=&Apache::lonprintout::character_chart($string);
if ($string eq '%.') {$string = '\%.';} #percent at the end of statement	# any & or # leftover should be safe to just escape
	$string=~s/([^\\]\|^)\&/$1\\\&/g;
	$string=~s/([^\\]\|^)\#/$1\\\#/g;
	$string=~s/\\|/\$\\mid\$/g;
	#single { or } How to escape?
}	}
return $string;	return $string;
}	}
Line 465 sub inner_xmlparse {	Line 484 sub inner_xmlparse {
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {	while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
my $lasttag=$$stack[-1];	my $lasttag=$$stack[-1];
if ($token->[1] =~ /^$lasttag$/i) {	if ($token->[1] =~ /^\Q$lasttag\E$/i) {
&Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>');	&Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>');
last;	last;
} else {	} else {
Line 500 sub inner_xmlparse {	Line 519 sub inner_xmlparse {
}	}
}	}

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

	##
	## Looks to see if there is a subroutine defined for this tag. If so, call it,
	## otherwise do not call it as we do not know what it is.
	##
sub callsub {	sub callsub {
my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';	my $currentstring='';
Line 565 sub callsub {	Line 584 sub callsub {
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
$style);	$style);
} else {	} else {
	if ($target eq 'tex') {
	# throw away tag name
	return '';
	}
#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");	#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {	if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {	if (defined($token->[4]) && ($metamode < 1)) {
Line 605 sub setup_globals {	Line 628 sub setup_globals {
my ($request,$target)=@_;	my ($request,$target)=@_;
$Apache::lonxml::request=$request;	$Apache::lonxml::request=$request;
$Apache::lonxml::registered = 0;	$Apache::lonxml::registered = 0;
	@Apache::lonxml::htmlareafields=();
$errorcount=0;	$errorcount=0;
$warningcount=0;	$warningcount=0;
$Apache::lonxml::default_homework_loaded=0;	$Apache::lonxml::default_homework_loaded=0;
Line 614 sub setup_globals {	Line 638 sub setup_globals {
@Apache::lonxml::extlinks=();	@Apache::lonxml::extlinks=();
@Apache::lonxml::ssi_info=();	@Apache::lonxml::ssi_info=();
$Apache::lonxml::post_evaluate=1;	$Apache::lonxml::post_evaluate=1;
	$Apache::lonxml::warnings_error_header='';
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 657 sub init_safespace {	Line 682 sub init_safespace {
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
$safeeval->permit("sort");	$safeeval->permit("sort");
	$safeeval->permit("time");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');	$safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
$safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');	$safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart');
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
	$safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval,
	'&chem_standard_order');

$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');	$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');	$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');	$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
Line 733 sub init_safespace {	Line 761 sub init_safespace {
$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');	$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
$safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');	$safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');	$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
	$safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR');
	$safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG');
	$safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange');

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

}	}

sub default_homework_load {	sub default_homework_load {
Line 757 sub default_homework_load {	Line 790 sub default_homework_load {
}	}
}	}

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

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

sub end_tag {	sub end_tag {
Line 784 sub initdepth {	Line 825 sub initdepth {
$Apache::lonxml::olddepth=-1;	$Apache::lonxml::olddepth=-1;
}	}

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

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

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

sub increment_counter {	sub increment_counter {
Line 890 sub get_all_text {	Line 947 sub get_all_text {
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ($token->[1] =~ /^$tag$/i) { $depth++; }	if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
$result.=$token->[4];	$result.=$token->[4];
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ( $token->[1] =~ /^$tag$/i) { $depth--; }	if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; }
#skip sending back the last end tag	#skip sending back the last end tag
if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {	if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) {
my $string=	my $string=
Line 924 sub get_all_text {	Line 981 sub get_all_text {
#never found the end tag ran out of text, throw error send back blank	#never found the end tag ran out of text, throw error send back blank
&error('Never found end tag for <'.$tag.	&error('Never found end tag for <'.$tag.
'> current string <pre>'.	'> current string <pre>'.
&HTML::Entities::encode($result).	&HTML::Entities::encode($result,'<>&"').
'</pre>');	'</pre>');
if ($gotfullstack) {	if ($gotfullstack) {
my $newstring='</'.$tag.'>'.$result;	my $newstring='</'.$tag.'>'.$result;
Line 942 sub get_all_text {	Line 999 sub get_all_text {
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];	$result.=$token->[2];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
if ( $token->[1] =~ /^$tag$/i) {	if ( $token->[1] =~ /^\Q$tag\E$/i) {
$$pars[-1]->unget_token($token); last;	$$pars[-1]->unget_token($token); last;
} else {	} else {
$result.=$token->[4];	$result.=$token->[4];
}	}
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; }
if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; }
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$result.=$token->[2];	$result.=$token->[2];
}	}
Line 981 sub parstring {	Line 1038 sub parstring {
unless ($_=~/\W/) {	unless ($_=~/\W/) {
my $val=$token->[2]->{$_};	my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\\"\'])/\\$1/g;	$val =~ s/([\%\@\\\"\'])/\\$1/g;
	$val =~ s/(\$[^{a-zA-Z_])/\\$1/g;
	$val =~ s/(\$)$/\\$1/;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";";	$temp .= "my \$$_=\"$val\";";
}	}
Line 1030 sub afterburn {	Line 1089 sub afterburn {
my $anchorname=$_;	my $anchorname=$_;
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;	$result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs;
}	}
}	}
if ($ENV{'form.link'}) {	if ($ENV{'form.link'}) {
Line 1038 sub afterburn {	Line 1097 sub afterburn {
my ($anchorname,$linkurl)=split(/\>/,$_);	my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;	$result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
}	}
}	}
if ($ENV{'form.anchor'}) {	if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};	my $anchorname=$ENV{'form.anchor'};
my $matchthis=$anchorname;	my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;	$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;	$result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
$result.=(<<"ENDSCRIPT");	$result.=(<<"ENDSCRIPT");
<script type="text/javascript">	<script type="text/javascript">
document.location.hash='$anchorname';	document.location.hash='$anchorname';
Line 1057 ENDSCRIPT	Line 1116 ENDSCRIPT

sub storefile {	sub storefile {
my ($file,$contents)=@_;	my ($file,$contents)=@_;
	&Apache::lonnet::correct_line_ends(\$contents);
if (my $fh=Apache::File->new('>'.$file)) {	if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;	print $fh $contents;
$fh->close();	$fh->close();
Line 1068 sub storefile {	Line 1128 sub storefile {
}	}

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

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

sub createnewsty {	sub createnewsty {
Line 1100 SIMPLECONTENT	Line 1159 SIMPLECONTENT

sub inserteditinfo {	sub inserteditinfo {
my ($result,$filecontents,$filetype)=@_;	my ($result,$filecontents,$filetype)=@_;
$filecontents = &HTML::Entities::encode($filecontents);	$filecontents = &HTML::Entities::encode($filecontents,'<>&"');
# my $editheader='<a href="#editsection">Edit below</a><hr />';	# my $editheader='<a href="#editsection">Edit below</a><hr />';
my $xml_help = '';	my $xml_help = '';
	my $initialize='';
if ($filetype eq 'html') {	if ($filetype eq 'html') {
$xml_help=Apache::loncommon::helpLatexCheatsheet();	my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons();
	$initialize=&Apache::lonhtmlcommon::htmlareaheaders().
	&Apache::lonhtmlcommon::spellheader();
	if (!&Apache::lonhtmlcommon::htmlareablocked() &&
	&Apache::lonhtmlcommon::htmlareabrowser()) {
	$initialize.=(<<FULLPAGE);
	<script type="text/javascript">
	$addbuttons

	HTMLArea.loadPlugin("FullPage");

	function initDocument() {
	var editor=new HTMLArea("filecont",config);
	editor.registerPlugin(FullPage);
	editor.generate();
	}
	</script>
	FULLPAGE
	} else {
	$initialize.=(<<FULLPAGE);
	<script type="text/javascript">
	$addbuttons
	function initDocument() {
	}
	</script>
	FULLPAGE
	}
	$result=~s/\<body([^\>]*)\>/\<body onload="initDocument()" $1\>/i;
	$xml_help=&Apache::loncommon::helpLatexCheatsheet();
}	}
my $cleanbut = '';	my $cleanbut = '';
if ($filetype eq 'html') {	if ($filetype eq 'html') {
Line 1117 sub inserteditinfo {	Line 1205 sub inserteditinfo {
'ed' => 'Edit');	'ed' => 'Edit');
my $buttons=(<<BUTTONS);	my $buttons=(<<BUTTONS);
$cleanbut	$cleanbut
<input type="submit" name="savethisfile" value="$lt{'st'}" />	<input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" />
<input type="submit" name="viewmode" value="$lt{'vi'}" />	<input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" />
BUTTONS	BUTTONS
	$buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont');
	$buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont');
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
	$initialize
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post">	<form method="post" name="xmledit">
$xml_help	$xml_help
<input type="hidden" name="editmode" value="$lt{'ed'}" />	<input type="hidden" name="editmode" value="$lt{'ed'}" />
$buttons<br />	$buttons<br />
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>	<textarea cols="80" rows="44" name="filecont" id="filecont">$filecontents</textarea>
<br />$buttons	<br />$buttons
<br />	<br />
</form>	</form>
$titledisplay	$titledisplay
	</body>
ENDFOOTER	ENDFOOTER
# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;	# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;	$result=~s/(\<\/body\>)/$editfooter/is;
Line 1178 sub handler {	Line 1270 sub handler {
&Apache::loncommon::content_type($request,'text/html');	&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,
	'lastrevisiondate'));
$request->send_http_header;	$request->send_http_header;

return OK if $request->header_only;	return OK if $request->header_only;
Line 1196 sub handler {	Line 1290 sub handler {
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {	if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {
if (&storefile($file,$ENV{'form.filecont'})) {	if (&storefile($file,$ENV{'form.filecont'})) {
$request->print("<font COLOR=\"#0000FF\">Updated: ". strftime("%d %b %H:%M:%S",localtime())." </font>");	&Apache::lonxml::info("<font COLOR=\"#0000FF\">".
	&mt('Updated').": ".
	&Apache::lonlocal::locallocaltime(time).
	" </font>");
}	}
}	}
}	}
Line 1204 sub handler {	Line 1301 sub handler {
my $result = '';	my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);	my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents eq -1) {	if ($filecontents eq -1) {
	my $bodytag=&Apache::loncommon::bodytag('File Error');
	my $fnf=&mt('File not found');
$result=(<<ENDNOTFOUND);	$result=(<<ENDNOTFOUND);
<html>	<html>
<head>	<head>
<title>File not found</title>	<title>$fnf</title>
</head>	</head>
<body bgcolor="#FFFFFF">	$bodytag
<b>File not found: $file</b>	<b>$fnf: $file</b>
</body>	</body>
</html>	</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();
Line 1225 ENDNOTFOUND	Line 1324 ENDNOTFOUND
}	}
} else {	} else {
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
	if ($filecontents=~/BEGIN LON-CAPA Internal/) {
	&Apache::lonxml::error(&mt('This file appears to be a rendering of a Lon-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.'));
	}

if ($ENV{'form.attemptclean'}) {	if ($ENV{'form.attemptclean'}) {
$filecontents=&htmlclean($filecontents,1);	$filecontents=&htmlclean($filecontents,1);
}	}
Line 1246 ENDNOTFOUND	Line 1349 ENDNOTFOUND
if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {	if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
my $displayfile=$request->uri;	my $displayfile=$request->uri;
$displayfile=~s/^\/[^\/]*//;	$displayfile=~s/^\/[^\/]*//;
$result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.	my $bodytag='<body bgcolor="#FFFFFF">';
	if ($ENV{'environment.remote'} eq 'off') {
	$bodytag=&Apache::loncommon::bodytag();
	}
	$result='<html>'.$bodytag.
	&Apache::lonxml::message_location().'<h3>'.
	$displayfile.
'</h3></body></html>';	'</h3></body></html>';
$result=&inserteditinfo($result,$filecontents,$filetype);	$result=&inserteditinfo($result,$filecontents,$filetype);
}	}
Line 1254 ENDNOTFOUND	Line 1363 ENDNOTFOUND
if ($filetype eq 'html') { writeallows($request->uri); }	if ($filetype eq 'html') { writeallows($request->uri); }


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

return OK;	return OK;
Line 1274 sub display_title {	Line 1383 sub display_title {
}	}

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

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

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

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

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

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

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

	sub message_location {
	return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
	}

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

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

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

Removed from v.1.283
changed lines
	Added in v.1.356