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.26

version 1.19, 2000/08/16 18:32:58	version 1.26, 2000/10/11 21:07:59
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;

sub xmlparse {	sub xmlparse {

my ($target,$content_file_string,$safeinit,%style_for_target) = @_;	my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
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");	$safeeval->deny(":base_io");
#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 63 sub xmlparse {	Line 72 sub xmlparse {
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);
Line 76 sub xmlparse {	Line 93 sub xmlparse {
&& ($#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 142 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 154 sub recurse {	Line 190 sub recurse {
&decreasedepth($tokenpat);}	&decreasedepth($tokenpat);}
}	}
pop @pat;	pop @pat;
	pop @Apache::lonxml::pwd;
}	}
return $output;	return $output;
}	}
Line 162 sub callsub {	Line 199 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 214 sub get_all_text {	Line 252 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 261 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]; }
}	}
Line 229 sub get_all_text {	Line 269 sub get_all_text {
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 {
	if ($_=~/\w+/) {
	$temp .= "my \$$_=\"$token->[2]->{$_}\";"
	}
	} @{$token->[3]};
return $temp;	return $temp;
}	}
	#<<<<<<< lonxml.pm

	sub handler {
	my $request=shift;

	my $target='web';
	$Apache::lonxml::debug=1;
	$request->content_type('text/html');
	# $request->send_http_header;
	if ($ENV{'browser.mathml'}) {
	$request->print( '<?xml version="1.0"?>'
	.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
	.'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
	.'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
	.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
	.'xmlns="http://www.w3.org/TR/REC-html40">'
	.'<body bgcolor="#FFFFFF">'."\n");
	} else {
	my $headerstring='<html>';
	if ($ENV{'browser.os'} eq 'mac') {
	$headerstring.="<head>\n"
	.'<meta Content-Type="text/html; charset=x-mac-roman">'
	."\n</head>\n";
	}
	$request->print($headerstring.'<body bgcolor="#FFFFFF">'."\n");
	}
	# $request->print(<<ENDHEADER);
	#<html>
	#<head>
	#<title>Just test</title>
	#</head>
	#<body bgcolor="#FFFFFF">
	#ENDHEADER
	# &Apache::lonhomework::send_header($request);
	my $file = "/home/httpd/html".$request->uri;
	my %mystyle;
	my $result = '';
	$result = Apache::lonxml::xmlparse($target, &Apache::lonnet::getfile($file),'',%mystyle);
	# $request->print("Result follows:");
	$request->print($result);
	# $request->print(":Result ends");
	}

	$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.26