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.31 and 1.51

version 1.31, 2000/11/01 17:25:36	version 1.51, 2001/02/13 00:15:49
Line 2	Line 2
# XML Parser Module	# XML Parser Module
#	#
# last modified 06/26/00 by Alexander Sakharuk	# last modified 06/26/00 by Alexander Sakharuk
	# 11/6 Gerd Kortemeyer
	# 6/1/1 Gerd Kortemeyer

package Apache::lonxml;	package Apache::lonxml;
	use vars
	qw(@pwd $outputstack $redirection $textredirection $on_offimport @extlinks);
use strict;	use strict;
use HTML::TokeParser;	use HTML::TokeParser;
use Safe;	use Safe;
	use Safe::Hole;
use Opcode;	use Opcode;
	use Apache::Constants qw(:common);

sub register {	sub register {
my $space;	my $space;
Line 19 sub register {	Line 24 sub register {
$Apache::lonxml::alltags{$temptag}=$space;	$Apache::lonxml::alltags{$temptag}=$space;
}	}
}	}

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

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') {$Apache::lonxml::textredirection = 0;}	if ($target eq 'meta') {
	$Apache::lonxml::textredirection = 0;
	$Apache::lonxml::on_offimport = 1;
	} elsif ($target eq 'grade') {
	$Apache::lonxml::textredirection = 0;
	$Apache::lonxml::on_offimport = 0;
	} else {
	$Apache::lonxml::textredirection = 1;
	$Apache::lonxml::on_offimport = 0;
	}
	#&printalltags();
my @pars = ();	my @pars = ();
@Apache::lonxml::pwd=();	@Apache::lonxml::pwd=();
my $pwd=$ENV{'request.filename'};	my $pwd=$ENV{'request.filename'};
Line 47 sub xmlparse {	Line 69 sub xmlparse {
my $result;	my $result;

my $safeeval = new Safe;	my $safeeval = new Safe;
	my $safehole = new Safe::Hole;
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
#need to inspect this class of ops	#need to inspect this class of ops
# $safeeval->deny(":base_orig");	# $safeeval->deny(":base_orig");
$safeinit .= ';$external::target='.$target.';';	$safeinit .= ';$external::target='.$target.';';
Line 66 sub xmlparse {	Line 90 sub xmlparse {
while ( $#pars > -1 ) {	while ( $#pars > -1 ) {
while ($token = $pars[$#pars]->get_token) {	while ($token = $pars[$#pars]->get_token) {
if ($token->[0] eq 'T') {	if ($token->[0] eq 'T') {
if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}	if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}
# $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');	# $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
# if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}	# if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}
# add tag to stack	# add tag to stack
push (@stack,$token->[1]);	push (@stack,$token->[1]);
# add parameters list to another stack	# add parameters list to another stack
push (@parstack,&parstring($token));	push (@parstack,&parstring($token));
&increasedepth($token);	&increasedepth($token);
if (exists $style_for_target{$token->[1]}) {	if (exists $style_for_target{$token->[1]}) {

if ($Apache::lonxml::redirection == 1) {	if ($Apache::lonxml::redirection == 1) {
$finaloutput .= &recurse($style_for_target{$token->[1]},	$finaloutput .= &recurse($style_for_target{$token->[1]},
$target,$safeeval,\%style_for_target,	$target,$safeeval,\%style_for_target,
@parstack);	@parstack);
} else {	} else {
$Apache::lonxml::outputstack .= &recurse($style_for_target{$token->[1]},	$Apache::lonxml::outputstack .= &recurse($style_for_target{$token->[1]},
$target,$safeeval,\%style_for_target,	$target,$safeeval,\%style_for_target,
@parstack);	@parstack);
}	}

} else {	} else {
$result = &callsub("start_$token->[1]", $target, $token,\@parstack,	$result = &callsub("start_$token->[1]", $target, $token,\@parstack,
\@pars, $safeeval, \%style_for_target);	\@pars, $safeeval, \%style_for_target);
}	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
# if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}	#if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
#clear out any tags that didn't end	#clear out any tags that didn't end
while ($token->[1] ne $stack[$#stack]	while ($token->[1] ne $stack[$#stack]
&& ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);}	&& ($#stack > -1)) {
	&Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
	pop @stack;pop @parstack;&decreasedepth($token);
	}

if (exists $style_for_target{'/'."$token->[1]"}) {	if (exists $style_for_target{'/'."$token->[1]"}) {

Line 166 sub recurse {	Line 193 sub recurse {
} 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)) {pop @innerstack;pop @innerparstack;	&& ($#innerstack > -1)) {
&decreasedepth($tokenpat);}	&Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
	pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
	}
$partstring = &callsub("end_$tokenpat->[1]",	$partstring = &callsub("end_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,	$target, $tokenpat, \@innerparstack,
\@pat, $safeeval, $style_for_target);	\@pat, $safeeval, $style_for_target);
Line 233 sub initdepth {	Line 262 sub initdepth {

sub increasedepth {	sub increasedepth {
my ($token) = @_;	my ($token) = @_;
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
$#Apache::lonxml::depthcounter--;
$Apache::lonxml::olddepth=$Apache::lonxml::depth;
}
$Apache::lonxml::depth++;	$Apache::lonxml::depth++;
# print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;	$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
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 $curdepth=join('_',@Apache::lonxml::depthcounter);
	&Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
	#print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
}	}

sub decreasedepth {	sub decreasedepth {
my ($token) = @_;	my ($token) = @_;
$Apache::lonxml::depth--;	$Apache::lonxml::depth--;
# print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";	if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
	$#Apache::lonxml::depthcounter--;
	$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
	}
	if ( $Apache::lonxml::depth < -1) {
	&Apache::lonxml::warning("Unbalanced tags in resource");
	$Apache::lonxml::depth='-1';
	}
	my $curdepth=join('_',@Apache::lonxml::depthcounter);
	&Apache::lonxml::debug("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 {
Line 258 sub get_all_text {	Line 295 sub get_all_text {
my $token;	my $token;
my $result='';	my $result='';
my $tag=substr($tag,1); #strip the / off the tag	my $tag=substr($tag,1); #strip the / off the tag
# &Apache::lonxml::debug("have:$tag:");	#&Apache::lonxml::debug("have:$tag:");
while (($depth >=0) && ($token = $pars->get_token)) {	while (($depth >=0) && ($token = $pars->get_token)) {
	#&Apache::lonxml::debug("token:$token->[0]:$depth:$token->[1]");
if ($token->[0] eq 'T') {	if ($token->[0] eq 'T') {
$result.=$token->[1];	$result.=$token->[1];
} elsif ($token->[0] eq 'S') {	} elsif ($token->[0] eq 'S') {
Line 268 sub get_all_text {	Line 306 sub get_all_text {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ( $token->[1] eq $tag) { $depth--; }	if ( $token->[1] eq $tag) { $depth--; }
#skip sending back the last end tag	#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; }	if ($depth > -1) { $result.=$token->[2]; } else {
	$pars->unget_token($token);
	}
}	}
}	}
	# &Apache::lonxml::debug("Exit:$result:");
return $result	return $result
}	}

Line 290 sub parstring {	Line 331 sub parstring {
my ($token) = @_;	my ($token) = @_;
my $temp='';	my $temp='';
map {	map {
if ($_=~/\w+/) {	unless ($_=~/\W/) {
$temp .= "my \$$_=\"$token->[2]->{$_}\";"	my $val=$token->[2]->{$_};
	$val =~ s/([\%\@\\])/\$1/;
	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
	$temp .= "my \$$_=\"$val\";"
}	}
} @{$token->[3]};	} @{$token->[3]};
return $temp;	return $temp;
}	}

	sub writeallows {
	my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
	my $thisdir=$thisurl;
	$thisdir=~s/\/[^\/]+$//;
	my %httpref=();
	map {
	$httpref{'httpref.'.
	&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;
	&Apache::lonnet::appenv(%httpref);
	}

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

my $target='web';	my $target='web';
$Apache::lonxml::debug=1;	$Apache::lonxml::debug=0;
if ($ENV{'browser.mathml'}) {	if ($ENV{'browser.mathml'}) {
$request->content_type('text/xml');	$request->content_type('text/xml');
} else {	} else {
Line 318 sub handler {	Line 373 sub handler {
# &Apache::lonhomework::send_header($request);	# &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;

$request->print(&Apache::lontexconvert::header());	$request->print(&Apache::lontexconvert::header());

$request->print('<body bgcolor="#FFFFFF">'."\n");	$request->print('<body bgcolor="#FFFFFF">'."\n");

my $file = "/home/httpd/html".$request->uri;	my $file=&Apache::lonnet::filelocation("",$request->uri);
my %mystyle;	my %mystyle;
my $result = '';	my $result = '';
$result = Apache::lonxml::xmlparse($target, &Apache::lonnet::getfile($file),'',%mystyle);	my $filecontents=&Apache::lonnet::getfile($file);
	if ($filecontents == -1) {
	&Apache::lonxml::error("<b> Unable to find <i>$file</i></b>");
	$filecontents='';
	} else {
	$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
	}
$request->print($result);	$request->print($result);


$request->print('</body>');	$request->print('</body>');
$request->print(&Apache::lontexconvert::footer());	$request->print(&Apache::lontexconvert::footer());
return 'OK';	writeallows($request->uri);
	return OK;
}	}

$Apache::lonxml::debug=0;	$Apache::lonxml::debug=0;
Line 341 sub debug {	Line 404 sub debug {
print "DEBUG:".$_[0]."<br>\n";	print "DEBUG:".$_[0]."<br>\n";
}	}
}	}

sub error {	sub error {
print "ERROR:".$_[0]."<br>\n";	print "ERROR:".$_[0]."<br>\n";
}	}

sub warning {	sub warning {
if ($Apache::lonxml::debug eq 1) {	if ($Apache::lonxml::debug eq 1) {
print "WARNING:".$_[0]."<br>\n";	print "WARNING:".$_[0]."<br>\n";
Line 352 sub warning {	Line 417 sub warning {

1;	1;
__END__	__END__

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

Removed from v.1.31
changed lines
	Added in v.1.51