version 1.15, 2000/08/03 18:24:24
|
version 1.19, 2000/08/16 18:32:58
|
Line 29 use Apache::scripttag;
|
Line 29 use Apache::scripttag;
|
|
|
sub xmlparse { |
sub xmlparse { |
|
|
my ($target,$content_file_string,%style_for_target) = @_; |
my ($target,$content_file_string,$safeinit,%style_for_target) = @_; |
my $pars = HTML::TokeParser->new(\$content_file_string); |
my @pars = (); |
|
push (@pars,HTML::TokeParser->new(\$content_file_string)); |
my $currentstring = ''; |
my $currentstring = ''; |
my $finaloutput = ''; |
my $finaloutput = ''; |
my $newarg = ''; |
my $newarg = ''; |
|
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"); |
|
if ( $safeinit ne '') {&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); |
|
|
#------------------------- Stack definition (in stack we have all current tags) |
|
|
|
my @stack = (); |
my @stack = (); |
my @parstack = (); |
my @parstack = (); |
|
&initdepth; |
#------------------------------------- Parse input string (content_file_string) |
|
|
|
my $token; |
my $token; |
|
while ( $#pars > -1 ) { |
while ($token = $pars->get_token) { |
while ($token = $pars[$#pars]->get_token) { |
if ($token->[0] eq 'T') { |
if ($token->[0] eq 'T') { |
$finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,''); |
$result=$token->[1]; |
} elsif ($token->[0] eq 'S') { |
# $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,''); |
# add tag to stack |
} elsif ($token->[0] eq 'S') { |
push (@stack,$token->[1]); |
# add tag to stack |
# add parameters list to another stack |
push (@stack,$token->[1]); |
push (@parstack,&parstring($token)); |
# add parameters list to another stack |
|
push (@parstack,&parstring($token)); |
if (exists $style_for_target{$token->[1]}) { |
&increasedepth($token); |
$finaloutput .= &recurse($style_for_target{$token->[1]}, |
if (exists $style_for_target{$token->[1]}) { |
$target,$safeeval,\%style_for_target, |
$finaloutput .= &recurse($style_for_target{$token->[1]}, |
@parstack); |
$target,$safeeval,\%style_for_target, |
} else { |
@parstack); |
my $result = &callsub("start_$token->[1]", $target, $token,\@parstack, |
} else { |
$pars, $safeeval, \%style_for_target); |
$result = &callsub("start_$token->[1]", $target, $token,\@parstack, |
if ($result ne "" ) { |
\@pars, $safeeval, \%style_for_target); |
$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 > -1)) {pop @stack;pop @parstack;&decreasedepth($token);} |
|
|
|
if (exists $style_for_target{'/'."$token->[1]"}) { |
|
$finaloutput .= &recurse($style_for_target{'/'."$token->[1]"}, |
|
$target,$safeeval,\%style_for_target, |
|
@parstack); |
|
} else { |
|
$result = &callsub("end_$token->[1]", $target, $token, \@parstack, |
|
\@pars,$safeeval, \%style_for_target); |
} |
} |
} |
} |
} elsif ($token->[0] eq 'E') { |
if ($result ne "" ) { |
#clear out any tags that didn't end |
if ( $#parstack > -1 ) { |
while ($token->[1] ne $stack[$#stack] |
|
&& ($#stack > 0)) {pop @stack;pop @parstack;} |
|
|
|
if (exists $style_for_target{'/'."$token->[1]"}) { |
|
$finaloutput .= &recurse($style_for_target{'/'."$token->[1]"}, |
|
$target,$safeeval,\%style_for_target, |
|
@parstack); |
|
} else { |
|
my $result = &callsub("end_$token->[1]", $target, $token, \@parstack, |
|
$pars,$safeeval, \%style_for_target); |
|
if ($result ne "") { |
|
$finaloutput .= &Apache::run::evaluate($result,$safeeval, |
$finaloutput .= &Apache::run::evaluate($result,$safeeval, |
$parstack[$#parstack]); |
$parstack[$#parstack]); |
|
} else { |
|
$finaloutput .= &Apache::run::evaluate($result,$safeeval,''); |
} |
} |
|
$result = ''; |
} |
} |
pop @stack; |
if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);} |
pop @parstack; |
|
} |
} |
|
pop @pars; |
} |
} |
return $finaloutput; |
return $finaloutput; |
} |
} |
Line 100 sub recurse {
|
Line 105 sub recurse {
|
my @innerstack = (); |
my @innerstack = (); |
my @innerparstack = (); |
my @innerparstack = (); |
my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_; |
my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_; |
my $pat = HTML::TokeParser->new(\$newarg); |
my @pat = (); |
|
push (@pat,HTML::TokeParser->new(\$newarg)); |
my $tokenpat; |
my $tokenpat; |
my $partstring = ''; |
my $partstring = ''; |
my $output=''; |
my $output=''; |
while ($tokenpat = $pat->get_token) { |
my $decls=''; |
if ($tokenpat->[0] eq 'T') { |
while ( $#pat > -1 ) { |
$partstring = $tokenpat->[1]; |
while ($tokenpat = $pat[$#pat]->get_token) { |
} elsif ($tokenpat->[0] eq 'S') { |
if ($tokenpat->[0] eq 'T') { |
push (@innerstack,$tokenpat->[1]); |
$partstring = $tokenpat->[1]; |
push (@innerparstack,&parstring($tokenpat)); |
} elsif ($tokenpat->[0] eq 'S') { |
$partstring = &callsub("start_$tokenpat->[1]", |
push (@innerstack,$tokenpat->[1]); |
$target, $tokenpat, \@innerparstack, |
push (@innerparstack,&parstring($tokenpat)); |
$pat, $safeeval, $style_for_target); |
&increasedepth($tokenpat); |
} elsif ($tokenpat->[0] eq 'E') { |
$partstring = &callsub("start_$tokenpat->[1]", |
#clear out any tags that didn't end |
$target, $tokenpat, \@innerparstack, |
while ($tokenpat->[1] ne $innerstack[$#innerstack] |
\@pat, $safeeval, $style_for_target); |
&& ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;} |
} elsif ($tokenpat->[0] eq 'E') { |
$partstring = &callsub("end_$tokenpat->[1]", |
#clear out any tags that didn't end |
$target, $tokenpat, \@innerparstack, |
while ($tokenpat->[1] ne $innerstack[$#innerstack] |
$pat, $safeeval, $style_for_target); |
&& ($#innerstack > -1)) {pop @innerstack;pop @innerparstack; |
} |
&decreasedepth($tokenpat);} |
#pass both the variable to the style tag, and the tag we |
$partstring = &callsub("end_$tokenpat->[1]", |
#are processing inside the <definedtag> |
$target, $tokenpat, \@innerparstack, |
if ( $partstring ne "" ) { |
\@pat, $safeeval, $style_for_target); |
$output .= &Apache::run::evaluate($partstring,$safeeval, |
} |
$parstack[$#parstack].$innerparstack[$#innerparstack]); |
#pass both the variable to the style tag, and the tag we |
|
#are processing inside the <definedtag> |
|
if ( $partstring ne "" ) { |
|
if ( $#parstack > -1 ) { |
|
if ( $#innerparstack > -1 ) { |
|
$decls= $parstack[$#parstack].$innerparstack[$#innerparstack]; |
|
} else { |
|
$decls= $parstack[$#parstack]; |
|
} |
|
} else { |
|
if ( $#innerparstack > -1 ) { |
|
$decls=$innerparstack[$#innerparstack]; |
|
} else { |
|
$decls=''; |
|
} |
|
} |
|
$output .= &Apache::run::evaluate($partstring,$safeeval,$decls); |
|
$partstring = ''; |
|
} |
|
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; |
|
&decreasedepth($tokenpat);} |
} |
} |
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; } |
pop @pat; |
} |
} |
return $output; |
return $output; |
} |
} |
Line 140 sub callsub {
|
Line 166 sub callsub {
|
if (my $space=$Apache::lonxml::alltags{$token->[1]}) { |
if (my $space=$Apache::lonxml::alltags{$token->[1]}) { |
#print "Calling sub $sub in $space \n"; |
#print "Calling sub $sub in $space \n"; |
$sub="$space\:\:$sub"; |
$sub="$space\:\:$sub"; |
$currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval,$style); |
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); |
|
$currentstring = &$sub($target,$token,$parstack,$parser, |
|
$safeeval,$style); |
} else { |
} else { |
#print "NOT Calling sub $sub\n"; |
#print "NOT Calling sub $sub\n"; |
if (defined($token->[4])) { |
if (defined($token->[4])) { |
Line 154 sub callsub {
|
Line 182 sub callsub {
|
return $currentstring; |
return $currentstring; |
} |
} |
|
|
|
sub initdepth { |
|
@Apache::lonxml::depthcounter=(); |
|
$Apache::lonxml::depth=-1; |
|
$Apache::lonxml::olddepth=-1; |
|
} |
|
|
|
sub increasedepth { |
|
my ($token) = @_; |
|
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { |
|
$#Apache::lonxml::depthcounter--; |
|
$Apache::lonxml::olddepth=$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]++; |
|
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { |
|
$Apache::lonxml::olddepth=$Apache::lonxml::depth; |
|
} |
|
} |
|
|
|
sub decreasedepth { |
|
my ($token) = @_; |
|
$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=''; |
|
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 parstring { |
sub parstring { |
my ($token) = @_; |
my ($token) = @_; |
my $temp=''; |
my $temp=''; |