# The LearningOnline Network with CAPA
# XML Parser Module
#
# last modified 06/26/00 by Alexander Sakharuk
package Apache::lonxml;
use strict;
use HTML::TokeParser;
use Safe;
sub register {
my $space;
my @taglist;
my $temptag;
($space,@taglist) = @_;
foreach $temptag (@taglist) {
$Apache::lonxml::alltags{$temptag}=$space;
}
}
use Apache::style;
use Apache::lontexconvert;
use Apache::run;
use Apache::londefdef;
use Apache::scripttag;
#================================================== Main subroutine: xmlparse
sub xmlparse {
my ($target,$content_file_string,%style_for_target) = @_;
my $pars = HTML::TokeParser->new(\$content_file_string);
my $currentstring = '';
my $finaloutput = '';
my $newarg = '';
my $safeeval = new Safe;
$safeeval->permit("entereval");
#-------------------- Redefinition of the target in the case of compound target
($target, my @tenta) = split('&&',$target);
#------------------------- Stack definition (in stack we have all current tags)
my @stack = ();
my @parstack = ();
#------------------------------------- Parse input string (content_file_string)
my $token;
while ($token = $pars->get_token) {
if ($token->[0] eq 'T') {
$finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
} elsif ($token->[0] eq 'S') {
# add tag to stack
push (@stack,$token->[1]);
# add parameters list to another stack
push (@parstack,&parstring($token));
if (exists $style_for_target{$token->[1]}) {
#basically recurse, but we never got more than one level down so just
#create the new context here
my @innerstack = ();
my @innerparstack = ();
# use style file definition
$newarg = $style_for_target{$token->[1]};
my $pat = HTML::TokeParser->new(\$newarg);
my $tokenpat = '';
my $partstring = '';
while ($tokenpat = $pat->get_token) {
if ($tokenpat->[0] eq 'T') {
$partstring = $tokenpat->[1];
} elsif ($tokenpat->[0] eq 'S') {
push (@innerstack,$tokenpat->[1]);
push (@innerparstack,&parstring($tokenpat));
$partstring = &callsub("start_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,
$pat, $safeeval);
} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
$partstring = &callsub("end_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,
$pat, $safeeval);
}
#pass both the variable to the style tag, and the tag we
#are processing inside the <definedtag>
$finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
$parstack[$#parstack].$innerparstack[$#innerparstack]);
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
}
} else {
my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
$pars, $safeeval);
$finaloutput .= &Apache::run::evaluate($result,$safeeval,
$parstack[$#parstack]);
}
} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end
while ($token->[1] ne $stack[$#stack]
&& ($#stack > 0)) {pop @stack;pop @parstack;}
if (exists $style_for_target{'/'."$token->[1]"}) {
my @innerstack = ();
my @innerparstack = ();
$newarg = $style_for_target{'/'."$token->[1]"};
my $pat = HTML::TokeParser->new(\$newarg);
my $tokenpat;
my $partstring = '';
while ($tokenpat = $pat->get_token) {
if ($tokenpat->[0] eq 'T') {
$partstring .= $tokenpat->[1];
} elsif ($tokenpat->[0] eq 'S') {
push (@innerstack,$tokenpat->[1]);
push (@innerparstack,&parstring($tokenpat));
$partstring = &callsub("start_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,
$pat, $safeeval);
} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
$partstring = &callsub("end_$tokenpat->[1]",
$target, $tokenpat, \@innerparstack,
$pat, $safeeval);
}
#pass both the variable to the style tag, and the tag we
#are processing inside the <definedtag>
$finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
$parstack[$#parstack].$innerparstack[$#innerparstack]);
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
}
} else {
my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
$pars,$safeeval);
$finaloutput .= &Apache::run::evaluate($result,$safeeval,
$parstack[$#parstack]);
}
pop @stack;
pop @parstack;
}
}
return $finaloutput;
}
sub callsub {
my ($sub,$target,$token,$parstack,$parser,$safeeval)=@_;
my $currentstring='';
{
no strict 'refs';
if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
#print "Calling sub $sub in $space \n";
$sub="$space\:\:$sub";
$currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval);
} else {
#print "NOT Calling sub $sub\n";
if (defined($token->[4])) {
$currentstring = $token->[4];
} else {
$currentstring = $token->[2];
}
}
use strict 'refs';
}
return $currentstring;
}
sub parstring {
my ($token) = @_;
my $temp='';
map {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
return $temp;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>