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.239 and 1.272

version 1.239, 2003/02/25 21:27:07	version 1.272, 2003/08/13 18:57:28
Line 69 use Safe::Hole();	Line 69 use Safe::Hole();
use Math::Cephes();	use Math::Cephes();
use Math::Random();	use Math::Random();
use Opcode();	use Opcode();
	use POSIX qw(strftime);


sub register {	sub register {
my ($space,@taglist) = @_;	my ($space,@taglist) = @_;
Line 95 use Apache::run();	Line 97 use Apache::run();
use Apache::londefdef();	use Apache::londefdef();
use Apache::scripttag();	use Apache::scripttag();
use Apache::edit();	use Apache::edit();
	use Apache::inputtags();
	use Apache::outputtags();
use Apache::lonnet();	use Apache::lonnet();
use Apache::File();	use Apache::File();
use Apache::loncommon();	use Apache::loncommon();
Line 151 $Apache::lonxml::counter_changed=0;	Line 155 $Apache::lonxml::counter_changed=0;
#internal check on whether to look at style defs	#internal check on whether to look at style defs
$Apache::lonxml::usestyle=1;	$Apache::lonxml::usestyle=1;

	#locations used to store the parameter string for style substitutions
	$Apache::lonxml::style_values='';
	$Apache::lonxml::style_end_values='';

sub xmlbegin {	sub xmlbegin {
my $output='';	my $output='';
if ($ENV{'browser.mathml'}) {	if ($ENV{'browser.mathml'}) {
Line 196 sub xmlend {	Line 204 sub xmlend {
my $message=$contrib{$idx.':message'};	my $message=$contrib{$idx.':message'};
$message=~s/\n/\<br \/\>/g;	$message=~s/\n/\<br \/\>/g;
$message=&Apache::lontexconvert::msgtexconverted($message);	$message=&Apache::lontexconvert::msgtexconverted($message);
	if ($contrib{$idx.':attachmenturl'}) {
	my ($fname,$ft)
	=($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/);
	$message.='<p>Attachment: <a href="'.
	&Apache::lonnet::tokenwrapper($contrib{$idx.':attachmenturl'}).
	'"><tt>'.$fname.'.'.$ft.'</tt></a>';
	}
if ($message) {	if ($message) {
if ($hidden) {	if ($hidden) {
$message='<font color="#888888">'.$message.'</font>';	$message='<font color="#888888">'.$message.'</font>';
Line 248 sub xmlend {	Line 263 sub xmlend {
}	}
if ($discussiononly) {	if ($discussiononly) {
$discussion.=(<<ENDDISCUSS);	$discussion.=(<<ENDDISCUSS);
<form action="/adm/feedback" method="post" name="mailform">	<form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
<input type="submit" name="discuss" value="Post Discussion" />	<input type="submit" name="discuss" value="Post Discussion" />
<input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />	<input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
<input type="hidden" name="symb" value="$symb" />	<input type="hidden" name="symb" value="$symb" />
Line 257 sub xmlend {	Line 272 sub xmlend {
<font size="1">Note: in anonymous discussion, your name is visible only to	<font size="1">Note: in anonymous discussion, your name is visible only to
course faculty</font><br />	course faculty</font><br />
<textarea name=comment cols=60 rows=10 wrap=hard></textarea>	<textarea name=comment cols=60 rows=10 wrap=hard></textarea>
	<p>
	Attachment (128 KB max size): <input type="file" name="attachment" />
	</p>
</form>	</form>
ENDDISCUSS	ENDDISCUSS
$discussion.=&Apache::lonfeedback::generate_preview_button();	$discussion.=&Apache::lonfeedback::generate_preview_button();
Line 370 sub printtokenheader {	Line 388 sub printtokenheader {
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'}) {
	$headerstring.=
	'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
}	}
return $headerstring;	return $headerstring;
}	}
Line 391 sub xmlparse {	Line 412 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();

#	#
# do we have a course style file?	# do we have a course style file?
#	#
Line 407 sub xmlparse {	Line 429 sub xmlparse {
}	}
}	}
}	}
	#&printalltags();
#&printalltags();
my @pars = ();	my @pars = ();
my $pwd=$ENV{'request.filename'};	my $pwd=$ENV{'request.filename'};
$pwd =~ s:/[^/]*$::;	$pwd =~ s:/[^/]*$::;
Line 427 sub xmlparse {	Line 448 sub xmlparse {

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

if ($ENV{'request.uri'}) {	if ($ENV{'request.uri'}) {
&writeallows($ENV{'request.uri'});	&writeallows($ENV{'request.uri'});
}	}
Line 456 sub htmlclean {	Line 478 sub htmlclean {
}	}

sub latex_special_symbols {	sub latex_special_symbols {
my ($current_token,$stack,$parstack,$where)=@_;	my ($string,$where)=@_;
if ($where eq 'header') {	if ($where eq 'header') {
$current_token =~ s/(\\\|_\|\^)/ /g;	$string =~ s/(\\\|_\|\^)/ /g;
$current_token =~ s/(\$\|%\|\#\|&\|\{\|\})/\\$1/g;	$string =~ s/(\$\|%\|\#\|&\|\{\|\})/\\$1/g;
} else {	} else {
$current_token=~s/\\ /\\char92 /g;	$string=~s/\\ /\\char92 /g;
$current_token=~s/\^/\\char94 /g;	$string=~s/\^/\\char94 /g;
$current_token=~s/\~/\\char126 /g;	$string=~s/\~/\\char126 /g;
$current_token=~s/(&[^a-z\#])/\\$1/g;	$string=~s/(&[^A-Za-z\#])/\\$1/g;
$current_token=~s/([^&])\#/$1\\#/g;	$string=~s/([^&])\#/$1\\#/g;
$current_token=~s/(\$\|_\|{\|})/\\$1/g;	$string=~s/(\$\|_\|{\|})/\\$1/g;
$current_token=~s/\\char92 /\\texttt{\\char92}/g;	$string=~s/\\char92 /\\texttt{\\char92}/g;
$current_token=~s/(>\|<)/\$$1\$/g; #more or less	$string=~s/(>\|<)/\$$1\$/g; #more or less
if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit	if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit
if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space	if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space
	if ($string eq '%.') {$string = '\%.';} #percent at the end of statement
}	}
return $current_token;	return $string;
}	}

sub inner_xmlparse {	sub inner_xmlparse {
Line 480 sub inner_xmlparse {	Line 503 sub inner_xmlparse {
my $finaloutput = '';	my $finaloutput = '';
my $result;	my $result;
my $token;	my $token;
	my $dontpop=0;
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') \|\| ($token->[0] eq 'D') ) {	if (($token->[0] eq 'T') \|\| ($token->[0] eq 'C') ) {
if ($metamode<1) {	if ($metamode<1) {
my $text=$token->[1];	my $text=$token->[1];
if ($token->[0] eq 'C' && $target eq 'tex') {	if ($token->[0] eq 'C' && $target eq 'tex') {
Line 491 sub inner_xmlparse {	Line 515 sub inner_xmlparse {
}	}
$result.=$text;	$result.=$text;
}	}
	} elsif (($token->[0] eq 'D')) {
	if ($metamode<1 && $target eq 'web') {
	my $text=$token->[1];
	$result.=$text;
	}
} elsif ($token->[0] eq 'PI') {	} elsif ($token->[0] eq 'PI') {
if ($metamode<1) {	if ($metamode<1 && $target eq 'web') {
$result=$token->[2];	$result=$token->[2];
}	}
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
Line 507 sub inner_xmlparse {	Line 536 sub inner_xmlparse {
my $string=$$style_for_target{$token->[1]}.	my $string=$$style_for_target{$token->[1]}.
'<LONCAPA_INTERNAL_TURN_STYLE_ON />';	'<LONCAPA_INTERNAL_TURN_STYLE_ON />';
&Apache::lonxml::newparser($pars,\$string);	&Apache::lonxml::newparser($pars,\$string);
	$Apache::lonxml::style_values=$$parstack[-1];
	$Apache::lonxml::style_end_values=$$parstack[-1];
} else {	} else {
$result = &callsub("start_$token->[1]", $target, $token, $stack,	$result = &callsub("start_$token->[1]", $target, $token, $stack,
$parstack, $pars, $safeeval, $style_for_target);	$parstack, $pars, $safeeval, $style_for_target);
}	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
my $lasttag=$$stack[-1];
if ($token->[1] =~ /^$lasttag$/i) {
&Apache::lonxml::warning('Using tag </'.$token->[1].'> as end tag to <'.$$stack[-1].'>');
last;
} else {
&Apache::lonxml::warning('Found tag </'.$token->[1].'> when looking for </'.$$stack[-1].'> in file');
&end_tag($stack,$parstack,$token);
}
}

if ($Apache::lonxml::usestyle &&	if ($Apache::lonxml::usestyle &&
exists($$style_for_target{'/'."$token->[1]"})) {	exists($$style_for_target{'/'."$token->[1]"})) {
$Apache::lonxml::usestyle=0;	$Apache::lonxml::usestyle=0;
my $string=$$style_for_target{'/'.$token->[1]}.	my $string=$$style_for_target{'/'.$token->[1]}.
'<LONCAPA_INTERNAL_TURN_STYLE_ON />';	'<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
&Apache::lonxml::newparser($pars,\$string);	&Apache::lonxml::newparser($pars,\$string);
	$Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
	$Apache::lonxml::style_end_values='';
	$dontpop=1;
} else {	} else {
$result = &callsub("end_$token->[1]", $target, $token, $stack,	#clear out any tags that didn't end
$parstack, $pars,$safeeval, $style_for_target);	while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
	my $lasttag=$$stack[-1];
	if ($token->[1] =~ /^$lasttag$/i) {
	&Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>');
	last;
	} else {
	&Apache::lonxml::warning('Found tag </'.$token->[1].'> on line '.$token->[3].' when looking for </'.$$stack[-1].'> in file');
	&end_tag($stack,$parstack,$token);
	}
	}
	$result = &callsub("end_$token->[1]", $target, $token, $stack,
	$parstack, $pars,$safeeval, $style_for_target);
}	}
} else {	} else {
&Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");	&Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
}	}
#evaluate variable refs in result	#evaluate variable refs in result
if ($result ne "") {	if ($result ne "") {
	my $extras;
	if (!$Apache::lonxml::usestyle) {
	$extras=$Apache::lonxml::style_values;
	}
if ( $#$parstack > -1 ) {	if ( $#$parstack > -1 ) {
$result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);	$result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
} else {	} else {
$result= &Apache::run::evaluate($result,$safeeval,'');	$result= &Apache::run::evaluate($result,$safeeval,$extras);
}	}
}	}
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') ) {
if ($target eq 'tex') {	#Style file definitions should be correct
$result=&latex_special_symbols($result,$stack,$parstack);	if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
}	$result=&latex_special_symbols($result);
	}
}	}

# Encode any high ASCII characters	# Encode any high ASCII characters
Line 562 sub inner_xmlparse {	Line 600 sub inner_xmlparse {
}	}
$result = '';	$result = '';

if ($token->[0] eq 'E') {	if ($token->[0] eq 'E' && !$dontpop) {
&end_tag($stack,$parstack,$token);	&end_tag($stack,$parstack,$token);
}	}
	$dontpop=0;
}	}
if ($#$pars > -1) {	if ($#$pars > -1) {
pop @$pars;	pop @$pars;
Line 707 sub init_safespace {	Line 746 sub init_safespace {
$safeeval->permit("sort");	$safeeval->permit("sort");
$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::lonnet::EXT,$safeeval,'&EXT');	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');

$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');	$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
Line 788 sub init_safespace {	Line 828 sub init_safespace {
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::run::run($safeinit,$safeeval);	&Apache::run::run($safeinit,$safeeval);
}	}

Line 795 sub default_homework_load {	Line 836 sub default_homework_load {
my ($safeeval)=@_;	my ($safeeval)=@_;
&Apache::lonxml::debug('Loading default_homework');	&Apache::lonxml::debug('Loading default_homework');
my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');	my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
if ($default == -1) {	if ($default eq -1) {
&Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");	&Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
} else {	} else {
&Apache::run::run($default,$safeeval);	&Apache::run::run($default,$safeeval);
Line 887 sub get_all_text_unbalanced {	Line 928 sub get_all_text_unbalanced {
}	}

sub increment_counter {	sub increment_counter {
$Apache::lonxml::counter++;	my ($increment) = @_;
	if (defined($increment) && $increment gt 0) {
	$Apache::lonxml::counter+=$increment;
	} else {
	$Apache::lonxml::counter++;
	}
$Apache::lonxml::counter_changed=1;	$Apache::lonxml::counter_changed=1;
}	}

sub init_counter {	sub init_counter {
if (defined($ENV{'form.counter'})) {	if (defined($ENV{'form.counter'})) {
$Apache::lonxml::counter=$ENV{'form.counter'};	$Apache::lonxml::counter=$ENV{'form.counter'};
	$Apache::lonxml::counter_changed=0;
} else {	} else {
$Apache::lonxml::counter=1;	$Apache::lonxml::counter=1;
&store_counter();	$Apache::lonxml::counter_changed=1;
}	}
$Apache::lonxml::counter_changed=0;
}	}

sub store_counter {	sub store_counter {
Line 907 sub store_counter {	Line 953 sub store_counter {
}	}

sub get_all_text {	sub get_all_text {
my($tag,$pars)= @_;	my($tag,$pars,$style)= @_;
&Apache::lonxml::debug("Got a ".ref($pars));	&Apache::lonxml::debug("Got a ".ref($pars));
my $gotfullstack=1;	my $gotfullstack=1;
if (ref($pars) ne 'ARRAY') {	if (ref($pars) ne 'ARRAY') {
$gotfullstack=0;	$gotfullstack=0;
$pars=[$pars];	$pars=[$pars];
}	}
my $depth=0;	&Apache::lonxml::debug("Got a ".ref($style));
my $token;	if (ref($style) ne 'HASH') {
my $result='';	$style={};
if ( $tag =~ m:^/: ) {	} else {
my $tag=substr($tag,1);	&Apache::lonhomework::showhash(%$style);
#&Apache::lonxml::debug("have:$tag:");	}
my $top_empty=0;	my $depth=0;
while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {	my $token;
while (($depth >=0) && ($token = $$pars[-1]->get_token)) {	my $result='';
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);	if ( $tag =~ m:^/: ) {
if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|($token->[0] eq 'D')) {	my $tag=substr($tag,1);
$result.=$token->[1];	#&Apache::lonxml::debug("have:$tag:");
} elsif ($token->[0] eq 'PI') {	my $top_empty=0;
$result.=$token->[2];	while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
} elsif ($token->[0] eq 'S') {	while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
if ($token->[1] =~ /^$tag$/i) { $depth++; }	#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
$result.=$token->[4];	if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|($token->[0] eq 'D')) {
} elsif ($token->[0] eq 'E') {	$result.=$token->[1];
if ( $token->[1] =~ /^$tag$/i) { $depth--; }	} elsif ($token->[0] eq 'PI') {
#skip sending back the last end tag	$result.=$token->[2];
if ($depth > -1) { $result.=$token->[2]; } else {	} elsif ($token->[0] eq 'S') {
$$pars[-1]->unget_token($token);	if ($token->[1] =~ /^$tag$/i) { $depth++; }
}	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
}	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
}	$result.=$token->[4];
if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }	} elsif ($token->[0] eq 'E') {
if (($depth >=0) && ($#$pars > 0) ) {	if ( $token->[1] =~ /^$tag$/i) { $depth--; }
pop(@$pars);	#skip sending back the last end tag
pop(@Apache::lonxml::pwd);	if ($depth == 0 && exists($$style{'/'.$token->[1]})) {
}	my $string=
}	'<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
if ($top_empty && $depth >= 0) {	$$style{'/'.$token->[1]}.
#never found the end tag ran out of text, throw error send back blank	$token->[2].
&error('Never found end tag for <'.$tag.'>');	'<LONCAPA_INTERNAL_TURN_STYLE_ON />';
if ($gotfullstack) {	&Apache::lonxml::newparser($pars,\$string);
my $newstring='</'.$tag.'>'.$result;	#&Apache::lonxml::debug("reParsing $string");
&Apache::lonxml::newparser($pars,\$newstring);	next;
}	}
$result='';	if ($depth > -1) {
}	$result.=$token->[2];
} else {	} else {
while ($#$pars > -1) {	$$pars[-1]->unget_token($token);
while ($token = $$pars[-1]->get_token) {	}
#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");	}
if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|	}
($token->[0] eq 'D')) {	if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
$result.=$token->[1];	if (($depth >=0) && ($#$pars > 0) ) {
} elsif ($token->[0] eq 'PI') {	pop(@$pars);
$result.=$token->[2];	pop(@Apache::lonxml::pwd);
} elsif ($token->[0] eq 'S') {	}
if ( $token->[1] =~ /^$tag$/i) {	}
$$pars[-1]->unget_token($token); last;	if ($top_empty && $depth >= 0) {
} else {	#never found the end tag ran out of text, throw error send back blank
$result.=$token->[4];	&error('Never found end tag for <'.$tag.
}	'> current string <pre>'.
} elsif ($token->[0] eq 'E') {	&HTML::Entities::encode($result).
$result.=$token->[2];	'</pre>');
}	if ($gotfullstack) {
}	my $newstring='</'.$tag.'>'.$result;
if (($#$pars > 0) ) {	&Apache::lonxml::newparser($pars,\$newstring);
pop(@$pars);	}
pop(@Apache::lonxml::pwd);	$result='';
} else { last; }	}
}	} else {
}	while ($#$pars > -1) {
if ($result =~ m\|<LONCAPA_INTERNAL_TURN_STYLE_ON />\|) {	while ($token = $$pars[-1]->get_token) {
$Apache::lonxml::usestyle=1;	#&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
}	if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|
#&Apache::lonxml::debug("Exit:$result:");	($token->[0] eq 'D')) {
return $result	$result.=$token->[1];
	} elsif ($token->[0] eq 'PI') {
	$result.=$token->[2];
	} elsif ($token->[0] eq 'S') {
	if ( $token->[1] =~ /^$tag$/i) {
	$$pars[-1]->unget_token($token); last;
	} else {
	$result.=$token->[4];
	}
	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
	if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
	} elsif ($token->[0] eq 'E') {
	$result.=$token->[2];
	}
	}
	if (($#$pars > 0) ) {
	pop(@$pars);
	pop(@Apache::lonxml::pwd);
	} else { last; }
	}
	}
	#&Apache::lonxml::debug("Exit:$result:");
	return $result
}	}

sub newparser {	sub newparser {
Line 995 sub newparser {	Line 1063 sub newparser {
} else {	} else {
push (@Apache::lonxml::pwd, $dir);	push (@Apache::lonxml::pwd, $dir);
}	}
# &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
# &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
}	}

sub parstring {	sub parstring {
Line 1007 sub parstring {	Line 1073 sub parstring {
my $val=$token->[2]->{$_};	my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\\"\'])/\\$1/g;	$val =~ s/([\%\@\\\"\'])/\\$1/g;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"	$temp .= "my \$$_=\"$val\";";
}	}
}	}
return $temp;	return $temp;
Line 1072 sub storefile {	Line 1138 sub storefile {
if (my $fh=Apache::File->new('>'.$file)) {	if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;	print $fh $contents;
$fh->close();	$fh->close();
	return 1;
} else {	} else {
&warning("Unable to save file $file");	&warning("Unable to save file $file");
	return 0;
}	}
}	}

Line 1100 sub inserteditinfo {	Line 1168 sub inserteditinfo {
my ($result,$filecontents)=@_;	my ($result,$filecontents)=@_;
$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 = Apache::loncommon::helpLatexCheatsheet();
	my $titledisplay=&display_title();
my $buttons=(<<BUTTONS);	my $buttons=(<<BUTTONS);
<input type="submit" name="attemptclean"	<input type="submit" name="attemptclean"
value="Save and then attempt to clean HTML" />	value="Save and then attempt to clean HTML" />
Line 1110 BUTTONS	Line 1180 BUTTONS
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post">	<form method="post">
	$xml_help
<input type="hidden" name="editmode" value="Edit" />	<input type="hidden" name="editmode" value="Edit" />
$buttons<br />	$buttons<br />
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>	<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
<br />$buttons	<br />$buttons
<br />	<br />
</form>	</form>
	$titledisplay
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 1150 sub get_target {	Line 1222 sub get_target {
}	}

sub handler {	sub handler {
my $request=shift;	my $request=shift;

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

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

if ($ENV{'browser.mathml'}) {	if ($ENV{'browser.mathml'}) {
$request->content_type('text/xml');	$request->content_type('text/xml');
} else {	} else {
$request->content_type('text/html');	$request->content_type('text/html');
}	}
&Apache::loncommon::no_cache($request);	&Apache::loncommon::no_cache($request);
$request->send_http_header;	$request->send_http_header;

return OK if $request->header_only;	return OK if $request->header_only;


my $file=&Apache::lonnet::filelocation("",$request->uri);	my $file=&Apache::lonnet::filelocation("",$request->uri);
#	#
# Edit action? Save file.	# Edit action? Save file.
#	#
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {	if (($ENV{'form.savethisfile'}) \|\| ($ENV{'form.attemptclean'})) {
&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>");
}	}
my %mystyle;	}
my $result = '';	}
my $filecontents=&Apache::lonnet::getfile($file);	my %mystyle;
if ($filecontents == -1) {	my $result = '';
$result=(<<ENDNOTFOUND);	my $filecontents=&Apache::lonnet::getfile($file);
	if ($filecontents eq -1) {
	$result=(<<ENDNOTFOUND);
<html>	<html>
<head>	<head>
<title>File not found</title>	<title>File not found</title>
Line 1191 sub handler {	Line 1265 sub handler {
</html>	</html>
ENDNOTFOUND	ENDNOTFOUND
$filecontents='';	$filecontents='';
if ($ENV{'request.state'} ne 'published') {	if ($ENV{'request.state'} ne 'published') {
$filecontents=&createnewhtml();	$filecontents=&createnewhtml();
$ENV{'form.editmode'}='Edit'; #force edit mode	$ENV{'form.editmode'}='Edit'; #force edit mode
}	}
} else {	} else {
unless ($ENV{'request.state'} eq 'published') {	unless ($ENV{'request.state'} eq 'published') {
if ($ENV{'form.attemptclean'}) {	if ($ENV{'form.attemptclean'}) {
$filecontents=&htmlclean($filecontents,1);	$filecontents=&htmlclean($filecontents,1);
}	}
}	#
if (!$ENV{'form.editmode'} \|\| $ENV{'form.viewmode'}) {	# we are in construction space, see if edit mode forced
$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,	&Apache::loncommon::get_unprocessed_cgi
'',%mystyle);	($ENV{'QUERY_STRING'},['editmode']);
	}
	if (!$ENV{'form.editmode'} \|\| $ENV{'form.viewmode'}) {
	$result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
	'',%mystyle);
	}
}	}
}

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

$request->print($result);	$request->print($result);

return OK;	return OK;
	}

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

sub debug {	sub debug {
Line 1262 sub error {	Line 1354 sub error {

sub warning {	sub warning {
$warningcount++;	$warningcount++;
if ($ENV{'request.state'} eq 'construct') {
print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";	if ($ENV{'form.grade_target'} ne 'tex') {
	if ($ENV{'request.state'} eq 'construct' \|\| $Apache::lonxml::debug) {
	print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
	}
}	}
}	}

Line 1325 sub register_insert {	Line 1420 sub register_insert {
my $line = $data[$i];	my $line = $data[$i];
if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }	if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }
if ( $line =~ /TABLE/ ) { last; }	if ( $line =~ /TABLE/ ) { last; }
my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);	my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
if ($tag) {	if ($tag) {
$insertlist{"$tagnum.tag"} = $tag;	$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.description"} = $descrip;	$insertlist{"$tagnum.description"} = $descrip;
Line 1333 sub register_insert {	Line 1428 sub register_insert {
$insertlist{"$tagnum.function"} = $function;	$insertlist{"$tagnum.function"} = $function;
if (!defined($show)) { $show='yes'; }	if (!defined($show)) { $show='yes'; }
$insertlist{"$tagnum.show"}= $show;	$insertlist{"$tagnum.show"}= $show;
	$insertlist{"$tagnum.helpfile"} = $helpfile;
	$insertlist{"$tagnum.helpdesc"} = $helpdesc;
$insertlist{"$tag.num"}=$tagnum;	$insertlist{"$tag.num"}=$tagnum;
$tagnum++;	$tagnum++;
}	}
Line 1367 sub description {	Line 1464 sub description {
return $insertlist{$tagnum.'.description'};	return $insertlist{$tagnum.'.description'};
}	}

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

# ----------------------------------------------------------------- whichuser	# ----------------------------------------------------------------- whichuser
# returns a list of $symb, $courseid, $domain, $name that is correct for	# returns a list of $symb, $courseid, $domain, $name that is correct for
# calls to lonnet functions for this setup.	# calls to lonnet functions for this setup.
# - looks for form.grade_ parameters	# - looks for form.grade_ parameters
sub whichuser {	sub whichuser {
my ($symb,$courseid,$domain,$name);	my ($passedsymb)=@_;
	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=$ENV{'form.grade_courseid'};
my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);	my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
if ($allowed) {	if ($allowed) {
$symb=$ENV{'form.grade_symb'};	$symb=$ENV{'form.grade_symb'};
$courseid=$ENV{'form.grade_courseid'};	$courseid=$ENV{'form.grade_courseid'};
Line 1383 sub whichuser {	Line 1495 sub whichuser {
$name=$ENV{'form.grade_username'};	$name=$ENV{'form.grade_username'};
}	}
} else {	} else {
$symb=&Apache::lonnet::symbread();	if (!$passedsymb) {
$courseid=$ENV{'request.course.id'};	$symb=&Apache::lonnet::symbread();
$domain=$ENV{'user.domain'};	} else {
$name=$ENV{'user.name'};	$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);	return ($symb,$courseid,$domain,$name,$publicuser);
}	}

1;	1;

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

Removed from v.1.239
changed lines
	Added in v.1.272