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.19 and 1.40

version 1.19, 2000/08/16 18:32:58	version 1.40, 2000/11/22 17:35:13
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

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;

sub register {	sub register {
Line 26 use Apache::run;	Line 29 use Apache::run;
use Apache::londefdef;	use Apache::londefdef;
use Apache::scripttag;	use Apache::scripttag;
#================================================== Main subroutine: xmlparse	#================================================== Main subroutine: xmlparse
	@pwd=();
	$outputstack = '';
	$redirection = 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;
	$Apache::lonxml::on_offimport = 1;
	}
my @pars = ();	my @pars = ();
push (@pars,HTML::TokeParser->new(\$content_file_string));	@Apache::lonxml::pwd=();
	my $pwd=$ENV{'request.filename'};
	$pwd =~ s:/[^/]*$::;
	&newparser(\@pars,\$content_file_string,$pwd);
my $currentstring = '';	my $currentstring = '';
my $finaloutput = '';	my $finaloutput = '';
my $newarg = '';	my $newarg = '';
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");
if ( $safeinit ne '') {&Apache::run::run($safeinit,$safeeval);}	$safeinit .= ';$external::target='.$target.';';
	$safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
	&Apache::run::run($safeinit,$safeeval);
#-------------------- Redefinition of the target in the case of compound target	#-------------------- Redefinition of the target in the case of compound target

($target, my @tenta) = split('&&',$target);	($target, my @tenta) = split('&&',$target);
Line 54 sub xmlparse {	Line 75 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') {
$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;}
# 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]}) {
$finaloutput .= &recurse($style_for_target{$token->[1]},
$target,$safeeval,\%style_for_target,	if ($Apache::lonxml::redirection == 1) {
@parstack);	$finaloutput .= &recurse($style_for_target{$token->[1]},
	$target,$safeeval,\%style_for_target,
	@parstack);
	} else {
	$Apache::lonxml::outputstack .= &recurse($style_for_target{$token->[1]},
	$target,$safeeval,\%style_for_target,
	@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;}
#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)) {pop @stack;pop @parstack;&decreasedepth($token);}

if (exists $style_for_target{'/'."$token->[1]"}) {	if (exists $style_for_target{'/'."$token->[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 {
	$Apache::lonxml::outputstack .= &recurse($style_for_target{'/'."$token->[1]"},
	$target,$safeeval,\%style_for_target,
	@parstack);
	}

} else {	} else {
$result = &callsub("end_$token->[1]", $target, $token, \@parstack,	$result = &callsub("end_$token->[1]", $target, $token, \@parstack,
\@pars,$safeeval, \%style_for_target);	\@pars,$safeeval, \%style_for_target);
}	}
}	}
if ($result ne "" ) {	if ($result ne "") {
if ( $#parstack > -1 ) {	if ( $#parstack > -1 ) {

	if ($Apache::lonxml::redirection == 1) {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,	$finaloutput .= &Apache::run::evaluate($result,$safeeval,
$parstack[$#parstack]);	$parstack[$#parstack]);
	} else {
	$Apache::lonxml::outputstack .= &Apache::run::evaluate($result,$safeeval,
	$parstack[$#parstack]);
	}

} else {	} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,'');	$finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
}	}
$result = '';	$result = '';
	} else {
	$finaloutput .= $result;
}	}
if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}	if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
}	}
pop @pars;	pop @pars;
	pop @Apache::lonxml::pwd;
}	}

return $finaloutput;	return $finaloutput;
}	}

Line 106 sub recurse {	Line 156 sub recurse {
my @innerparstack = ();	my @innerparstack = ();
my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;	my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
my @pat = ();	my @pat = ();
push (@pat,HTML::TokeParser->new(\$newarg));	&newparser(\@pat,\$newarg);
my $tokenpat;	my $tokenpat;
my $partstring = '';	my $partstring = '';
my $output='';	my $output='';
Line 114 sub recurse {	Line 164 sub recurse {
while ( $#pat > -1 ) {	while ( $#pat > -1 ) {
while ($tokenpat = $pat[$#pat]->get_token) {	while ($tokenpat = $pat[$#pat]->get_token) {
if ($tokenpat->[0] eq 'T') {	if ($tokenpat->[0] eq 'T') {
$partstring = $tokenpat->[1];	if ($Apache::lonxml::textredirection == 1) {$partstring = $tokenpat->[1];}
} elsif ($tokenpat->[0] eq 'S') {	} elsif ($tokenpat->[0] eq 'S') {
push (@innerstack,$tokenpat->[1]);	push (@innerstack,$tokenpat->[1]);
push (@innerparstack,&parstring($tokenpat));	push (@innerparstack,&parstring($tokenpat));
Line 154 sub recurse {	Line 204 sub recurse {
&decreasedepth($tokenpat);}	&decreasedepth($tokenpat);}
}	}
pop @pat;	pop @pat;
	pop @Apache::lonxml::pwd;
}	}
return $output;	return $output;
}	}
Line 162 sub callsub {	Line 213 sub callsub {
my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;	my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';	my $currentstring='';
{	{
	my $sub1;
no strict 'refs';	no strict 'refs';
if (my $space=$Apache::lonxml::alltags{$token->[1]}) {	if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
#print "Calling sub $sub in $space \n";	#&Apache::lonxml::debug("Calling sub $sub in $space<br>\n");
$sub="$space\:\:$sub";	$sub1="$space\:\:$sub";
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);	$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
$currentstring = &$sub($target,$token,$parstack,$parser,	$currentstring = &$sub1($target,$token,$parstack,$parser,
$safeeval,$style);	$safeeval,$style);
} else {	} else {
#print "NOT Calling sub $sub\n";	#&Apache::lonxml::debug("NOT Calling sub $sub in $space<br>\n");
if (defined($token->[4])) {	if (defined($token->[4])) {
$currentstring = $token->[4];	$currentstring = $token->[4];
} else {	} else {
Line 190 sub initdepth {	Line 242 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);
	# print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]<br>\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;
	}
	# my $curdepth=join('_',@Apache::lonxml::depthcounter);
	# print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth <br>\n";
}	}

sub get_all_text {	sub get_all_text {
Line 214 sub get_all_text {	Line 268 sub get_all_text {
my $depth=0;	my $depth=0;
my $token;	my $token;
my $result='';	my $result='';
	my $tag=substr($tag,1); #strip the / off the tag
	# &Apache::lonxml::debug("have:$tag:");
while (($depth >=0) && ($token = $pars->get_token)) {	while (($depth >=0) && ($token = $pars->get_token)) {
if ($token->[0] eq 'T') {	if ($token->[0] eq 'T') {
$result.=$token->[1];	$result.=$token->[1];
Line 221 sub get_all_text {	Line 277 sub get_all_text {
if ($token->[1] eq $tag) { $depth++; }	if ($token->[1] eq $tag) { $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] 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);
	}
}	}
}	}
return $result	return $result
}	}

	sub newparser {
	my ($parser,$contentref,$dir) = @_;
	push (@$parser,HTML::TokeParser->new($contentref));
	if ( $dir eq '' ) {
	push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
	} else {
	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 {
my ($token) = @_;	my ($token) = @_;
my $temp='';	my $temp='';
map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};	map {
	unless ($_=~/\W/) {
	$temp .= "my \$$_=\"$token->[2]->{$_}\";"
	}
	} @{$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 {
	my $request=shift;

	my $target='web';
	$Apache::lonxml::debug=1;
	if ($ENV{'browser.mathml'}) {
	$request->content_type('text/xml');
	} else {
	$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;

	return 'OK' if $request->header_only;

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

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

	my $file = "/home/httpd/html".$request->uri;
	my %mystyle;
	my $result = '';
	$result = Apache::lonxml::xmlparse($target, &Apache::lonnet::getfile($file),'',%mystyle);
	$request->print($result);

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

	$Apache::lonxml::debug=0;
	sub debug {
	if ($Apache::lonxml::debug eq 1) {
	print "DEBUG:".$_[0]."<br>\n";
	}
	}
	sub error {
	print "ERROR:".$_[0]."<br>\n";
	}
	sub warning {
	if ($Apache::lonxml::debug eq 1) {
	print "WARNING:".$_[0]."<br>\n";
	}
	}

1;	1;
__END__	__END__

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

Removed from v.1.19
changed lines
	Added in v.1.40