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.145 and 1.181

version 1.145, 2002/01/03 16:18:00	version 1.181, 2002/07/15 19:45:18
Line 60	Line 60

package Apache::lonxml;	package Apache::lonxml;
use vars	use vars
qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);	qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode);
use strict;	use strict;
use HTML::TokeParser;	use HTML::LCParser();
use HTML::TreeBuilder;	use HTML::TreeBuilder();
use Safe;	use HTML::Entities();
use Safe::Hole;	use Safe();
use Math::Cephes qw(:trigs :hypers :bessels erf erfc);	use Safe::Hole();
use Math::Random qw(:all);	use Math::Cephes();
use Opcode;	use Math::Random();
	use Opcode();

sub register {	sub register {
my ($space,@taglist) = @_;	my ($space,@taglist) = @_;
Line 89 sub deregister {	Line 90 sub deregister {
}	}

use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
use Apache::lontexconvert;	use Apache::lontexconvert();
use Apache::style;	use Apache::style();
use Apache::run;	use Apache::run();
use Apache::londefdef;	use Apache::londefdef();
use Apache::scripttag;	use Apache::scripttag();
use Apache::edit;	use Apache::edit();
use Apache::lonnet;	use Apache::lonnet();
use Apache::File;	use Apache::File();
use Apache::loncommon;	use Apache::loncommon();

#================================================== Main subroutine: xmlparse	#================================================== Main subroutine: xmlparse
#debugging control, to turn on debugging modify the correct handler	#debugging control, to turn on debugging modify the correct handler
Line 128 $evaluate = 1;	Line 129 $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;

	# a pointer the the Apache request object
	$Apache::lonxml::request='';

sub xmlbegin {	sub xmlbegin {
my $output='';	my $output='';
if ($ENV{'browser.mathml'}) {	if ($ENV{'browser.mathml'}) {
Line 175 sub xmlend {	Line 182 sub xmlend {
}	}
my $sender='Anonymous';	my $sender='Anonymous';
if ((!$contrib{$idx.':anonymous'}) \|\| ($seeid)) {	if ((!$contrib{$idx.':anonymous'}) \|\| ($seeid)) {
$sender=$contrib{$idx.':sendername'}.' at '.	$sender=$contrib{$idx.':plainname'}.' ('.
$contrib{$idx.':senderdomain'};	$contrib{$idx.':sendername'}.' at '.
	$contrib{$idx.':senderdomain'}.')';
if ($contrib{$idx.':anonymous'}) {	if ($contrib{$idx.':anonymous'}) {
$sender.=' (anonymous)';	$sender.=' [anonymous] '.
	$contrib{$idx.':screenname'};
}	}
if ($seeid) {	if ($seeid) {
if ($hidden) {	if ($hidden) {
Line 189 sub xmlend {	Line 198 sub xmlend {
$symb.':::'.$idx.'">Hide</a>';	$symb.':::'.$idx.'">Hide</a>';
}	}
}	}
	} else {
	if ($contrib{$idx.':screenname'}) {
	$sender='<i>'.$contrib{$idx.':screenname'}.'</i>';
	}
}	}
$discussion.='<p><b>'.$sender.'</b> ('.	$discussion.='<p><b>'.$sender.'</b> ('.
localtime($contrib{$idx.':timestamp'}).	localtime($contrib{$idx.':timestamp'}).
Line 316 sub fontsettings() {	Line 329 sub fontsettings() {

sub registerurl {	sub registerurl {
my $forcereg=shift;	my $forcereg=shift;
if ($ENV{'request.publicaccess'}) {	my $target = shift;
return	my $result = '';
	if ($target eq 'edit') {
	$result .="<script>\n menu.currentURL=null;\n".
	&Apache::loncommon::browser_and_searcher_javascript().
	"\n</script>\n";
	}
	if ((($ENV{'request.publicaccess'}) \|\|
	(!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
	(!$forcereg)) {
	return $result.
'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';	'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
}	}
if ($Apache::lonxml::registered && !$forcereg) { return ''; }	if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;	$Apache::lonxml::registered=1;
	my $nothing='';
	if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
	my $timesync='menu.syncclock(1000*'.time.');';
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {	if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) \|\| ($forcereg)) {
my $hwkadd='';	my $hwkadd='';
if ($ENV{'REQUEST_URI'}=~/\.(problem\|exam\|quiz\|assess\|survey\|form)$/) {	if ($ENV{'request.filename'}=~/\.(problem\|exam\|quiz\|assess\|survey\|form)$/) {
if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {	if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDSUBM);	$hwkadd.=(<<ENDSUBM);
menu.switchbutton	menu.switchbutton(7,1,'subm.gif','view sub','missions','gocmd("/adm/grades","submission")');
(7,1,'subm.gif','view sub','missions',
'gocmd("/adm/grades","submission")');
ENDSUBM	ENDSUBM
}	}
if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {	if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDGRDS);	$hwkadd.=(<<ENDGRDS);
menu.switchbutton	menu.switchbutton(7,2,'pgrd.gif','problem','grades','gocmd("/adm/grades","gradingmenu")');
(7,2,'pgrd.gif','problem','grades',
'gocmd("/adm/grades","viewgrades")');
ENDGRDS	ENDGRDS
}	}
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {	if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDPARM);	$hwkadd.=(<<ENDPARM);
menu.switchbutton	menu.switchbutton(7,3,'pparm.gif','problem','parms','gocmd("/adm/parmset","set")');
(7,3,'pparm.gif','problem','parms',
'gocmd("/adm/parmset","set")');
ENDPARM	ENDPARM
}	}
}	}
return (<<ENDREGTHIS);	$result = (<<ENDREGTHIS);

<script language="JavaScript">	<script language="JavaScript">
// BEGIN LON-CAPA Internal	// BEGIN LON-CAPA Internal

function LONCAPAreg() {	function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
menu.clearTimeout(menu.menucltim);	menu.clearTimeout(menu.menucltim);
	$timesync
menu.currentURL=window.location.pathname;	menu.currentURL=window.location.pathname;
	menu.reloadURL=window.location.pathname;
menu.currentStale=0;	menu.currentStale=0;
menu.clearbut(3,1);	menu.clearbut(3,1);
menu.switchbutton	menu.switchbutton
Line 380 ENDPARM	Line 401 ENDPARM
}	}

function LONCAPAstale() {	function LONCAPAstale() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
menu.currentStale=1;	menu.currentStale=1;
menu.switchbutton	if (menu.reloadURL!='' && menu.reloadURL!= null) {
(3,1,'reload.gif','return','location','go(currentURL)');	menu.switchbutton
	(3,1,'reload.gif','return','location','go(reloadURL)');
	}
menu.clearbut(7,1);	menu.clearbut(7,1);
menu.clearbut(7,2);	menu.clearbut(7,2);
menu.clearbut(7,3);	menu.clearbut(7,3);
Line 399 ENDPARM	Line 422 ENDPARM
ENDREGTHIS	ENDREGTHIS

} else {	} else {
return (<<ENDDONOTREGTHIS);	$result = (<<ENDDONOTREGTHIS);

<script language="JavaScript">	<script language="JavaScript">
// BEGIN LON-CAPA Internal	// BEGIN LON-CAPA Internal

function LONCAPAreg() {	function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");	menu=window.open("$nothing","LONCAPAmenu","",false);
	$timesync
menu.currentStale=1;	menu.currentStale=1;
menu.clearbut(2,1);	menu.clearbut(2,1);
menu.clearbut(2,3);	menu.clearbut(2,3);
Line 426 ENDREGTHIS	Line 450 ENDREGTHIS
// END LON-CAPA Internal	// END LON-CAPA Internal
</script>	</script>
ENDDONOTREGTHIS	ENDDONOTREGTHIS

}	}
	return $result;
}	}

sub loadevents() {	sub loadevents() {
Line 447 sub printalltags {	Line 471 sub printalltags {
}	}

sub xmlparse {	sub xmlparse {
my ($target,$content_file_string,$safeinit,%style_for_target) = @_;	my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;

	&setup_globals($request,$target);
	#
	# do we have a course style file?
	#

	if ($ENV{'request.course.id'}) {
	my $bodytext=
	$ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
	if ($bodytext) {
	my $location=&Apache::lonnet::filelocation('',$bodytext);
	my $styletext=&Apache::lonnet::getfile($location);
	if ($styletext ne '-1') {
	%style_for_target = (%style_for_target,
	&Apache::style::styleparser($target,$styletext));
	}
	}
	}

&setup_globals($target);
#&printalltags();	#&printalltags();
my @pars = ();	my @pars = ();
my $pwd=$ENV{'request.filename'};	my $pwd=$ENV{'request.filename'};
Line 463 sub xmlparse {	Line 504 sub xmlparse {

($target, my @tenta) = split('&&',$target);	($target, my @tenta) = split('&&',$target);

my @stack = ();	my @stack = ();
my @parstack = ();	my @parstack = ();
&initdepth;	&initdepth;

Line 485 sub htmlclean {	Line 526 sub htmlclean {

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

$output=~s/\<(br\|hr\|img\|meta\|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;	$output=~s/\<(br\|hr\|img\|meta\|allow)(.*?)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;	$output=~s/\<\/(br\|hr\|img\|meta\|allow)\>//gis;
unless ($full) {	unless ($full) {
$output=~s/\<[\/]*(body\|head\|html)\>//gis;	$output=~s/\<[\/]*(body\|head\|html)\>//gis;
Line 533 sub inner_xmlparse {	Line 574 sub inner_xmlparse {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
#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)) {
&Apache::lonxml::warning('Missing tag </'.$$stack['-1'].'> in file');	my $lasttag=$$stack[-1];
&end_tag($stack,$parstack,$token);	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 (exists($$style_for_target{'/'."$token->[1]"})) {	if (exists($$style_for_target{'/'."$token->[1]"})) {
Line 557 sub inner_xmlparse {	Line 604 sub inner_xmlparse {
#evaluate variable refs in result	#evaluate variable refs in result
if ($result ne "") {	if ($result ne "") {
if ( $#$parstack > -1 ) {	if ( $#$parstack > -1 ) {
if ($Apache::lonxml::redirection) {	$result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);
$Apache::lonxml::outputstack['-1'] .=
&Apache::run::evaluate($result,$safeeval,$$parstack['-1']);
} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,
$$parstack['-1']);
}
} else {	} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,'');	$result= &Apache::run::evaluate($result,$safeeval,'');
}	}
$result = '';	}
}	# Encode any high ASCII characters
	if (!$Apache::lonxml::prevent_entity_encode) {
	$result=&HTML::Entities::encode($result,"\200-\377");
	}
	if ($Apache::lonxml::redirection) {
	$Apache::lonxml::outputstack['-1'] .= $result;
	} else {
	$finaloutput.=$result;
	}
	$result = '';

if ($token->[0] eq 'E') {	if ($token->[0] eq 'E') {
&end_tag($stack,$parstack,$token);	&end_tag($stack,$parstack,$token);
}	}
Line 581 sub inner_xmlparse {	Line 632 sub inner_xmlparse {
# $finaloutput.=&endredirection;	# $finaloutput.=&endredirection;
# }	# }


if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {	if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);	$finaloutput=&afterburn($finaloutput);
}	}
Line 613 sub recurse {	Line 665 sub recurse {
$safeeval, $style_for_target);	$safeeval, $style_for_target);
} elsif ($tokenpat->[0] eq 'E') {	} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]	while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > -1)) {	&& ($#innerstack > -1)) {
&Apache::lonxml::warning('Missing tag </'.$innerstack['-1'].'> in style');	my $lasttag=$innerstack[-1];
&end_tag(\@innerstack,\@innerparstack,$tokenpat);	if ($tokenpat->[1] =~ /^$lasttag$/i) {
	&Apache::lonxml::warning('Using tag </'.$tokenpat->[1].'> as end tag to <'.$innerstack[-1].'>');
	last;
	} else {
	&Apache::lonxml::warning('Found tag </'.$tokenpat->[1].'> when looking for </'.$innerstack[-1].'> in file');
	&end_tag(\@innerstack,\@innerparstack,$tokenpat);
	}
}	}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,	$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,	\@innerstack, \@innerparstack, \@pat,
Line 677 sub callsub {	Line 735 sub callsub {
}	}
if (!$deleted) {	if (!$deleted) {
if ($space) {	if ($space) {
#&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode");
$sub1="$space\:\:$sub";	$sub1="$space\:\:$sub";
($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,	($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
$parstack,$parser,$safeeval,	$parstack,$parser,$safeeval,
$style);	$style);
} else {	} else {
#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");	#&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)) {
$currentstring = $token->[4];	$currentstring = $token->[4];
Line 717 sub callsub {	Line 775 sub callsub {
}	}

sub setup_globals {	sub setup_globals {
my ($target)=@_;	my ($request,$target)=@_;
	$Apache::lonxml::request=$request;
$Apache::lonxml::registered = 0;	$Apache::lonxml::registered = 0;
@Apache::lonxml::pwd=();	@Apache::lonxml::pwd=();
@Apache::lonxml::extlinks=();	@Apache::lonxml::extlinks=();
Line 746 sub setup_globals {	Line 805 sub setup_globals {
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 0;	$Apache::lonxml::evaluate = 0;
$Apache::lonxml::import = 0;	$Apache::lonxml::import = 0;
	} elsif ($target eq 'analyze') {
	$Apache::lonxml::redirection = 0;
	$Apache::lonxml::metamode = 0;
	$Apache::lonxml::evaluate = 1;
	$Apache::lonxml::import = 1;
} else {	} else {
$Apache::lonxml::redirection = 0;	$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
Line 869 sub decreasedepth {	Line 933 sub decreasedepth {
#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 {	sub get_all_text_unbalanced {
	my($tag,$pars)= @_;
	my $token;
	my $result='';
	$tag='<'.$tag.'>';
	while ($token = $$pars[-1]->get_token) {
	if (($token->[0] eq 'T')\|\|($token->[0] eq 'C')\|\|($token->[0] eq 'D')) {
	$result.=$token->[1];
	} elsif ($token->[0] eq 'PI') {
	$result.=$token->[2];
	} elsif ($token->[0] eq 'S') {
	$result.=$token->[4];
	} elsif ($token->[0] eq 'E') {
	$result.=$token->[2];
	}
	if ($result =~ /(.)$tag(.)/) {
	&Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
	&Apache::lonxml::debug('Result is :'.$1);
	$result=$1;
	my $redo=$tag.$2;
	&Apache::lonxml::newparser($pars,\$redo);
	last;
	}
	}
	return $result
	}

	sub get_all_text {
my($tag,$pars)= @_;	my($tag,$pars)= @_;
my $depth=0;	my $depth=0;
my $token;	my $token;
Line 885 sub get_all_text {	Line 975 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] eq $tag) { $depth++; }	if ($token->[1] =~ /^$tag$/i) { $depth++; }
$result.=$token->[4];	$result.=$token->[4];
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ( $token->[1] eq $tag) { $depth--; }	if ( $token->[1] =~ /^$tag$/i) { $depth--; }
#skip sending back the last end tag	#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; } else {	if ($depth > -1) { $result.=$token->[2]; } else {
$pars->unget_token($token);	$pars->unget_token($token);
Line 903 sub get_all_text {	Line 993 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] eq $tag) {	if ( $token->[1] =~ /^$tag$/i) {
$pars->unget_token($token); last;	$pars->unget_token($token); last;
} else {	} else {
$result.=$token->[4];	$result.=$token->[4];
Line 919 sub get_all_text {	Line 1009 sub get_all_text {

sub newparser {	sub newparser {
my ($parser,$contentref,$dir) = @_;	my ($parser,$contentref,$dir) = @_;
push (@$parser,HTML::TokeParser->new($contentref));	push (@$parser,HTML::LCParser->new($contentref));
$$parser['-1']->xml_mode('1');	$$parser['-1']->xml_mode('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]);
Line 936 sub parstring {	Line 1026 sub parstring {
foreach (@{$token->[3]}) {	foreach (@{$token->[3]}) {
unless ($_=~/\W/) {	unless ($_=~/\W/) {
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\";"
}	}
Line 966 sub writeallows {	Line 1056 sub writeallows {
#	#
sub afterburn {	sub afterburn {
my $result=shift;	my $result=shift;
foreach (split(/&/,$ENV{'QUERY_STRING'})) {	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
my ($name, $value) = split(/=/,$_);	['highlight','anchor','link']);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if (($name eq 'highlight')\|\|($name eq 'anchor')\|\|($name eq 'link')) {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
}
}
if ($ENV{'form.highlight'}) {	if ($ENV{'form.highlight'}) {
foreach (split(/\,/,$ENV{'form.highlight'})) {	foreach (split(/\,/,$ENV{'form.highlight'})) {
my $anchorname=$_;	my $anchorname=$_;
Line 1011 sub storefile {	Line 1093 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();
	} else {
	&warning("Unable to save file $file");
}	}
}	}

sub inserteditinfo {	sub createnewhtml {
my ($result,$filecontents)=@_;	my $filecontents=(<<SIMPLECONTENT);
unless ($filecontents) {
$filecontents=(<<SIMPLECONTENT);
<html>	<html>
<head>	<head>
<title>	<title>
Line 1031 sub inserteditinfo {	Line 1113 sub inserteditinfo {
</body>	</body>
</html>	</html>
SIMPLECONTENT	SIMPLECONTENT
}	return $filecontents;
my $editheader='<a href="#editsection">Edit below</a><hr />';	}


	sub inserteditinfo {
	my ($result,$filecontents)=@_;
	$filecontents = &HTML::Entities::encode($filecontents);
	# my $editheader='<a href="#editsection">Edit below</a><hr />';
	my $buttons=(<<BUTTONS);
	<input type="submit" name="attemptclean"
	value="Save and then attempt to clean HTML" />
	<input type="submit" name="savethisfile" value="Save this" />
	<input type="submit" name="viewmode" value="View" />
	BUTTONS
my $editfooter=(<<ENDFOOTER);	my $editfooter=(<<ENDFOOTER);
<hr />	<hr />
<a name="editsection" />	<a name="editsection" />
<form method="post">	<form method="post">
	<input type="hidden" name="editmode" value="Edit" />
	$buttons<br />
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>	<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
	<br />$buttons
<br />	<br />
<input type="submit" name="attemptclean"
value="Save and then attempt to clean HTML" />
<input type="submit" name="savethisfile" value="Save this" />
</form>	</form>
ENDFOOTER	ENDFOOTER
$result=~s/(\<body[^\>]*\>)/$1$editheader/is;	# $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;	$result=~s/(\<\/body\>)/$editfooter/is;
return $result;	return $result;
}	}

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

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

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

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

Line 1077 sub handler {	Line 1198 sub handler {
}	}
}	}
my %mystyle;	my %mystyle;
my $result = '';	my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);	my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents == -1) {	if ($filecontents == -1) {
$result=(<<ENDNOTFOUND);	$result=(<<ENDNOTFOUND);
Line 1091 sub handler {	Line 1212 sub handler {
</html>	</html>
ENDNOTFOUND	ENDNOTFOUND
$filecontents='';	$filecontents='';
	if ($ENV{'request.state'} ne 'published') {
	$filecontents=&createnewhtml();
	$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);
}
}	}
$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);	}
	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'}))) {
	my $displayfile=$request->uri;
	$displayfile=~s/^\/[^\/]*//;
	$result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.
	'</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 debug {	sub debug {
if ($Apache::lonxml::debug eq 1) {	if ($Apache::lonxml::debug eq 1) {
print("DEBUG:".$_[0]."<br />\n");	$\|=1;
	print("DEBUG:".&HTML::Entities::encode($_[0])."<br />\n");
}	}
}	}

sub error {	sub error {
if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {	if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {
print "<b>ERROR:</b>".$_[0]."<br />\n";	# If printing in construction space, put the error inside <pre></pre>
	print "<b>ERROR:</b>".join("\n",@_)."\n";
} else {	} else {
print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";	print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
#notify author	#notify author
&Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);	&Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_));
#notify course	#notify course
if ( $ENV{'request.course.id'} ) {	if ( $ENV{'request.course.id'} ) {
my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};	my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
Line 1134 sub error {	Line 1270 sub error {
foreach my $user (split /\,/, $users) {	foreach my $user (split /\,/, $users) {
($user,my $domain) = split /:/, $user;	($user,my $domain) = split /:/, $user;
&Apache::lonmsg::user_normal_msg($user,$domain,	&Apache::lonmsg::user_normal_msg($user,$domain,
"Error [$declutter]",$_[0]);	"Error [$declutter]",join('<br />',@_));
}	}
}	}

#FIXME probably shouldn't have me get everything forever.	#FIXME probably shouldn't have me get everything forever.
&Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);	&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]);	#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
}	}
}	}

sub warning {	sub warning {
if ($ENV{'request.state'} eq 'construct') {	if ($ENV{'request.state'} eq 'construct') {
print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";	print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
}	}
}	}

Line 1155 sub get_param {	Line 1291 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 ( ! $args ) { return undef; }
if ( $args =~ /my \$$param=\"/ ) {	if ( $args =~ /my \$$param=\"/ ) {
return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'	return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
} else {	} else {

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

Removed from v.1.145
changed lines
	Added in v.1.181