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.69 and 1.78

version 1.69, 2001/05/04 16:10:17	version 1.78, 2001/05/26 15:31:33
Line 6	Line 6
# 6/1/1 Gerd Kortemeyer	# 6/1/1 Gerd Kortemeyer
# 2/21,3/13 Guy	# 2/21,3/13 Guy
# 3/29,5/4 Gerd Kortemeyer	# 3/29,5/4 Gerd Kortemeyer
	# 5/10 Scott Harrison
	# 5/26 Gerd Kortemeyer

package Apache::lonxml;	package Apache::lonxml;
use vars	use vars
qw(@pwd @outputstack $redirection $import @extlinks $metamode);	qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
use strict;	use strict;
use HTML::TokeParser;	use HTML::TokeParser;
use Safe;	use Safe;
use Safe::Hole;	use Safe::Hole;
use Opcode;	use Opcode;

	sub register {
	my $space;
	my @taglist;
	my $temptag;
	($space,@taglist) = @_;
	foreach $temptag (@taglist) {
	$Apache::lonxml::alltags{$temptag}=$space;
	}
	}

use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
	use Apache::lontexconvert;
	use Apache::style;
	use Apache::run;
	use Apache::londefdef;
	use Apache::scripttag;
	use Apache::edit;
	#================================================== Main subroutine: xmlparse
	#debugging control, to turn on debugging modify the correct handler
	$Apache::lonxml::debug=0;

	#path to the directory containing the file currently being processed
	@pwd=();

	#these two are used for capturing a subset of the output for later processing,
	#don't touch them directly use &startredirection and &endredirection
	@outputstack = ();
	$redirection = 0;

	#controls wheter the <import> tag actually does
	$import = 1;
	@extlinks=();

	# meta mode is a bit weird only some output is to be turned off
	#<output> tag turns metamode off (defined in londefdef.pm)
	$metamode = 0;

	# turns on and of run::evaluate actually derefencing var refs
	$evaluate = 1;

	# data structure for eidt mode, determines what tags can go into what other tags
	%insertlist=();

	#stores the list of active tag namespaces
	@namespace=();

sub xmlbegin {	sub xmlbegin {
my $output='';	my $output='';
Line 37 sub xmlend {	Line 83 sub xmlend {
return '</html>';	return '</html>';
}	}

	sub fontsettings() {
	my $headerstring='';
	if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
	$headerstring.=
	'<meta Content-Type="text/html; charset=x-mac-roman">';
	}
	return $headerstring;
	}

sub registerurl {	sub registerurl {
return (<<ENDSCRIPT);	return (<<ENDSCRIPT);
<script language="JavaScript">	<script language="JavaScript">
	// BEGIN LON-CAPA Internal
function LONCAPAreg() {	function LONCAPAreg() {
if (window.location.pathname!="/res/adm/pages/menu.html") {	if (window.location.pathname!="/res/adm/pages/menu.html") {
menu=window.open("","LONCAPAmenu");	menu=window.open("","LONCAPAmenu");
Line 54 sub registerurl {	Line 110 sub registerurl {
menu.currentStale=1;	menu.currentStale=1;
}	}
}	}
	// END LON-CAPA Internal
</script>	</script>
ENDSCRIPT	ENDSCRIPT
}	}
Line 66 sub unloadevents() {	Line 123 sub unloadevents() {
return 'LONCAPAstale();';	return 'LONCAPAstale();';
}	}

sub register {
my $space;
my @taglist;
my $temptag;
($space,@taglist) = @_;
foreach $temptag (@taglist) {
$Apache::lonxml::alltags{$temptag}=$space;
}
}

sub printalltags {	sub printalltags {
my $temp;	my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {	foreach $temp (sort keys %Apache::lonxml::alltags) {
&Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");	&Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
}	}
}	}
use Apache::style;
use Apache::run;
use Apache::londefdef;
use Apache::scripttag;
use Apache::edit;
#================================================== Main subroutine: xmlparse
@pwd=();
@outputstack = ();
$redirection = 0;
$import = 1;
@extlinks=();
$metamode = 0;

sub xmlparse {	sub xmlparse {

my ($target,$content_file_string,$safeinit,%style_for_target) = @_;	my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
if ($target eq 'meta') {	if ($target eq 'meta') {
# meta mode is a bit weird only some output is to be turned off
#<output> tag turns metamode off (defined in londefdef.pm)
$Apache::lonxml::redirection = 0;	$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;	$Apache::lonxml::metamode = 1;
	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 0;	$Apache::lonxml::import = 0;
} elsif ($target eq 'grade') {	} elsif ($target eq 'grade') {
&startredirection;	&startredirection;
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;	$Apache::lonxml::import = 1;
} else {	} elsif ($target eq 'modified') {
	$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;	$Apache::lonxml::metamode = 0;
	$Apache::lonxml::evaluate = 0;
	$Apache::lonxml::import = 0;
	} else {
$Apache::lonxml::redirection = 0;	$Apache::lonxml::redirection = 0;
	$Apache::lonxml::metamode = 0;
	$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;	$Apache::lonxml::import = 1;
}	}
#&printalltags();	#&printalltags();
Line 128 sub xmlparse {	Line 169 sub xmlparse {
my $safehole = new Safe::Hole;	my $safehole = new Safe::Hole;
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
	$safeeval->permit("sort");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
#need to inspect this class of ops	#need to inspect this class of ops
Line 296 sub recurse {	Line 338 sub recurse {
sub callsub {	sub callsub {
my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;	my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';	my $currentstring='';
	my $nodefault;
{	{
my $sub1;	my $sub1;
no strict 'refs';	no strict 'refs';
Line 311 sub callsub {	Line 354 sub callsub {
$space=$Apache::lonxml::alltags{$tag}	$space=$Apache::lonxml::alltags{$tag}
}	}
if ($space) {	if ($space) {
&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");	#&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
$sub1="$space\:\:$sub";	$sub1="$space\:\:$sub";
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);	$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
$currentstring .= &$sub1($target,$token,$parstack,$parser,	($currentstring,$nodefault) = &$sub1($target,$token,$parstack,$parser,
$safeeval,$style);	$safeeval,$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<br />\n");
if ($metamode <1) {	if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {	if (defined($token->[4]) && ($metamode < 1)) {
$currentstring .= $token->[4];	$currentstring = $token->[4];
} else {	} else {
$currentstring .= $token->[2];	$currentstring = $token->[2];
}	}
}	}
}	}
if ($target eq 'edit' && $token->[0] eq 'E') {	&Apache::lonxml::debug("nodefalt:$nodefault:");
$currentstring .= &Apache::edit::tag_end($target,$token,$parstack,$parser,	if ($currentstring eq '' && $nodefault eq '') {
$safeeval,$style);	if ($target eq 'edit') {
	&Apache::lonxml::debug("doing default edit for $token->[1]");
	if ($token->[0] eq 'S') {
	$currentstring = &Apache::edit::tag_start($target,$token);
	} elsif ($token->[0] eq 'E') {
	$currentstring = &Apache::edit::tag_end($target,$token);
	}
	} elsif ($target eq 'modified') {
	if ($token->[0] eq 'S') {
	$currentstring = $token->[4];
	$currentstring.=&Apache::edit::handle_insert();
	} else {
	$currentstring = $token->[2];
	}
	}
}	}
use strict 'refs';	use strict 'refs';
}	}
Line 342 sub startredirection {	Line 399 sub startredirection {

sub endredirection {	sub endredirection {
if (!$Apache::lonxml::redirection) {	if (!$Apache::lonxml::redirection) {
&Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuggin 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--;
Line 472 sub writeallows {	Line 529 sub writeallows {
#	#
# Afterburner handles anchors, highlights and links	# Afterburner handles anchors, highlights and links
#	#

sub afterburn {	sub afterburn {
my $result=shift;	my $result=shift;
map {	map {
Line 515 ENDSCRIPT	Line 571 ENDSCRIPT
return $result;	return $result;
}	}

	sub inserteditinfo {
	my ($result,$filecontents)=@_;
	unless ($filecontents) {
	$filecontents=(<<SIMPLECONTENT);
	<html>
	<head>
	<title>
	Title of Document Goes Here
	</title>
	</head>
	<body bgcolor="#FFFFFF">

	Body of Document Goes Here

	</body>
	</html>
	SIMPLECONTENT
	}
	my $editheader='<a href="#editsection">Edit below</a><hr />';
	my $editfooter=(<<ENDFOOTER);
	<hr />
	<a name="editsection" />
	<form method="post">
	<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
	<br />
	<input type="submit" name="savethisfile" value="Save this file" />
	</form>
	ENDFOOTER
	$result=~s/(\<body[^\>]*\>)/$1$editheader/is;
	$result=~s/(\<\/body\>)/$editfooter/is;
	return $result;
	}

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

Line 528 sub handler {	Line 617 sub handler {
$request->content_type('text/html');	$request->content_type('text/html');
}	}

# $request->print(<<ENDHEADER);
#<html>
#<head>
#<title>Just test</title>
#</head>
#<body bgcolor="#FFFFFF">
#ENDHEADER
# &Apache::lonhomework::send_header($request);
$request->send_http_header;	$request->send_http_header;

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

	#
	# Edit action? Save file.
	#
	unless ($ENV{'request.state'} eq 'published') {
	if ($ENV{'form.savethisfile'}) {

	}
	}

my $file=&Apache::lonnet::filelocation("",$request->uri);	my $file=&Apache::lonnet::filelocation("",$request->uri);
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) {
&Apache::lonxml::error("<b> Unable to find <i>$file</i></b>");	$result=(<<ENDNOTFOUND);
	<html>
	<head>
	<title>File not found</title>
	</head>
	<body bgcolor="#FFFFFF">
	<b>File not found: $file</b>
	</body>
	</html>
	ENDNOTFOUND
$filecontents='';	$filecontents='';
} else {	} else {
$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);	$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
}	}

	#
	# Edit action? Insert editing commands
	#
	unless ($ENV{'request.state'} eq 'published') {
	$result=&inserteditinfo($result,$filecontents);
	}

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

writeallows($request->uri);	writeallows($request->uri);
Line 565 sub debug {	Line 670 sub debug {
}	}

sub error {	sub error {
if ($Apache::lonxml::debug eq 1) {	if (($Apache::lonxml::debug eq 1) \|\| ($ENV{'request.state'} eq 'construct') ) {
print "<b>ERROR:</b>".$_[0]."<br />\n";	print "<b>ERROR:</b>".$_[0]."<br />\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 />";
Line 579 sub error {	Line 684 sub error {
&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
}	}
}	}

#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'}",$_[0]);
#&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 ($Apache::lonxml::debug eq 1) {	if ($ENV{'request.state'} eq 'construct') {
print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";	print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
}	}
}	}

	sub register_insert {
	my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
	my $i;
	my $tagnum=0;
	my @order;
	for ($i=0;$i < $#data; $i++) {
	my $line = $data[$i];
	if ( $line =~ /^\#/ \|\| $line =~ /^\s*\n/) { next; }
	if ( $line =~ /TABLE/ ) { last; }
	my ($tag,$descrip,$function,$show) = split(/,/, $line);
	$insertlist{"$tagnum.tag"} = $tag;
	$insertlist{"$tagnum.description"} = $descrip;
	$insertlist{"$tagnum.function"} = $function;
	$insertlist{"$tagnum.show"}= $show;
	$tagnum++;
	}
	$i++; #skipping TABLE line
	$tagnum = 0;
	for (;$i < $#data;$i++) {
	my $line = $data[$i];
	my ($mnemonic,@which) = split(/ +/,$line);
	my $tag = $insertlist{"$tagnum.tag"};
	for (my $j=0;$j <$#which;$j++) {
	if ( $which[$j] eq 'Y' ) {
	if ($insertlist{"$j.show"} ne 'no') {
	push(@{ $insertlist{"$tag.which"} },$j);
	}
	}
	}
	$tagnum++;
	}
	}
1;	1;
__END__	__END__

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

Removed from v.1.69
changed lines
	Added in v.1.78