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.41 and 1.54

version 1.41, 2000/12/04 22:10:23	version 1.54, 2001/02/19 20:40:55
Line 3	Line 3
#	#
# last modified 06/26/00 by Alexander Sakharuk	# last modified 06/26/00 by Alexander Sakharuk
# 11/6 Gerd Kortemeyer	# 11/6 Gerd Kortemeyer
	# 6/1/1 Gerd Kortemeyer

package Apache::lonxml;	package Apache::lonxml;
use vars	use vars
Line 12 use HTML::TokeParser;	Line 13 use HTML::TokeParser;
use Safe;	use Safe;
use Safe::Hole;	use Safe::Hole;
use Opcode;	use Opcode;
	use Apache::Constants qw(:common);

sub register {	sub register {
my $space;	my $space;
Line 22 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;
Line 42 sub xmlparse {	Line 50 sub xmlparse {
if ($target eq 'meta') {	if ($target eq 'meta') {
$Apache::lonxml::textredirection = 0;	$Apache::lonxml::textredirection = 0;
$Apache::lonxml::on_offimport = 1;	$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 104 sub xmlparse {	Line 119 sub xmlparse {
#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 175 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 216 sub callsub {	Line 236 sub callsub {
my $sub1;	my $sub1;
no strict 'refs';	no strict 'refs';
if (my $space=$Apache::lonxml::alltags{$token->[1]}) {	if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
#&Apache::lonxml::debug("Calling sub $sub in $space<br>\n");	#&Apache::lonxml::debug("Calling sub $sub in $space<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 = &$sub1($target,$token,$parstack,$parser,
$safeeval,$style);	$safeeval,$style);
} else {	} else {
#&Apache::lonxml::debug("NOT Calling sub $sub in $space<br>\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 247 sub increasedepth {	Line 267 sub increasedepth {
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);	my $curdepth=join('_',@Apache::lonxml::depthcounter);
# print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]<br>\n";	&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 {
Line 258 sub decreasedepth {	Line 279 sub decreasedepth {
$#Apache::lonxml::depthcounter--;	$#Apache::lonxml::depthcounter--;
$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;	$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
}	}
# my $curdepth=join('_',@Apache::lonxml::depthcounter);	if ( $Apache::lonxml::depth < -1) {
# print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth <br>\n";	&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 269 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 284 sub get_all_text {	Line 311 sub get_all_text {
}	}
}	}
}	}
	# &Apache::lonxml::debug("Exit:$result:");
return $result	return $result
}	}

Line 304 sub parstring {	Line 332 sub parstring {
my $temp='';	my $temp='';
map {	map {
unless ($_=~/\W/) {	unless ($_=~/\W/) {
$temp .= "my \$$_=\"$token->[2]->{$_}\";"	my $val=$token->[2]->{$_};
	$val =~ s/([\%\@\\])/\\$1/g;
	#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
	$temp .= "my \$$_=\"$val\";"
}	}
} @{$token->[3]};	} @{$token->[3]};
return $temp;	return $temp;
Line 323 sub writeallows {	Line 354 sub writeallows {

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 342 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());
writeallows($request->uri);	writeallows($request->uri);
return 'OK';	return OK;
}	}

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

sub error {	sub error {
print "ERROR:".$_[0]."<br>\n";	if ($Apache::lonxml::debug eq 1) {
	print "ERROR:".$_[0]."<br />\n";
	} else {
	print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
	#notify author
	&Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
	#notify course
	if ( $ENV{'request.course.id'} ) {
	my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
	foreach my $user (split /\,/, $users) {
	($user,my $domain) = split /:/, $user;
	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
	}
	}

	#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','103',"Error in $ENV{'request.filename'}",$_[0]);
	}
}	}

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";
}	}
}	}

1;	1;
__END__	__END__

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

Removed from v.1.41
changed lines
	Added in v.1.54