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.17 and 1.31

version 1.17, 2000/08/08 19:34:29	version 1.31, 2000/11/01 17:25:36
Line 26 use Apache::run;	Line 26 use Apache::run;
use Apache::londefdef;	use Apache::londefdef;
use Apache::scripttag;	use Apache::scripttag;
#================================================== Main subroutine: xmlparse	#================================================== Main subroutine: xmlparse
	@Apache::lonxml::pwd=();
	$Apache::lonxml::outputstack = '';
	$Apache::lonxml::redirection = 1;
	$Apache::lonxml::textredirection = 1;


sub xmlparse {	sub xmlparse {

my ($target,$content_file_string,%style_for_target) = @_;	my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
	if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
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;
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
	$safeeval->deny(":base_io");
	#need to inspect this class of ops
	# $safeeval->deny(":base_orig");
	$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 50 sub xmlparse {	Line 66 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();	&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;}	&& ($#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;}	if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
}	}
pop @pars;	pop @pars;
	pop @Apache::lonxml::pwd;
}	}

return $finaloutput;	return $finaloutput;
}	}

Line 102 sub recurse {	Line 147 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 110 sub recurse {	Line 155 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));
&increasedepth();	&increasedepth($tokenpat);
$partstring = &callsub("start_$tokenpat->[1]",	$partstring = &callsub("start_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,	$target, $tokenpat, \@innerparstack,
\@pat, $safeeval, $style_for_target);	\@pat, $safeeval, $style_for_target);
Line 122 sub recurse {	Line 167 sub recurse {
#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)) {pop @innerstack;pop @innerparstack;
&decreasedepth;}	&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 147 sub recurse {	Line 192 sub recurse {
$partstring = '';	$partstring = '';
}	}
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;	if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
&decreasedepth;}	&decreasedepth($tokenpat);}
}	}
pop @pat;	pop @pat;
	pop @Apache::lonxml::pwd;
}	}
return $output;	return $output;
}	}
Line 158 sub callsub {	Line 204 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 185 sub initdepth {	Line 232 sub initdepth {
}	}

sub increasedepth {	sub increasedepth {
	my ($token) = @_;
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {	if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
$#Apache::lonxml::depthcounter--;	$#Apache::lonxml::depthcounter--;
$Apache::lonxml::olddepth=$Apache::lonxml::depth;	$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;
Line 197 sub increasedepth {	Line 246 sub increasedepth {
}	}

sub decreasedepth {	sub decreasedepth {
	my ($token) = @_;
$Apache::lonxml::depth--;	$Apache::lonxml::depth--;
	# print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
	}

	sub get_all_text {

	my($tag,$pars)= @_;
	my $depth=0;
	my $token;
	my $result='';
	my $tag=substr($tag,1); #strip the / off the tag
	# &Apache::lonxml::debug("have:$tag:");
	while (($depth >=0) && ($token = $pars->get_token)) {
	if ($token->[0] eq 'T') {
	$result.=$token->[1];
	} elsif ($token->[0] eq 'S') {
	if ($token->[1] eq $tag) { $depth++; }
	$result.=$token->[4];
	} elsif ($token->[0] eq 'E') {
	if ( $token->[1] eq $tag) { $depth--; }
	#skip sending back the last end tag
	if ($depth > -1) { $result.=$token->[2]; }
	}
	}
	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 {
	if ($_=~/\w+/) {
	$temp .= "my \$$_=\"$token->[2]->{$_}\";"
	}
	} @{$token->[3]};
return $temp;	return $temp;
}	}

	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());
	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.17
changed lines
	Added in v.1.31