--- loncom/xml/lonxml.pm 2000/07/18 21:27:10 1.11 +++ loncom/xml/lonxml.pm 2000/08/16 18:32:58 1.19 @@ -8,6 +8,7 @@ package Apache::lonxml; use strict; use HTML::TokeParser; use Safe; +use Opcode; sub register { my $space; @@ -28,135 +29,148 @@ use Apache::scripttag; sub xmlparse { - my ($target,$content_file_string,%style_for_target) = @_; - my $pars = HTML::TokeParser->new(\$content_file_string); + my ($target,$content_file_string,$safeinit,%style_for_target) = @_; + my @pars = (); + push (@pars,HTML::TokeParser->new(\$content_file_string)); my $currentstring = ''; my $finaloutput = ''; my $newarg = ''; + my $result; my $safeeval = new Safe; $safeeval->permit("entereval"); + $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 ($target, my @tenta) = split('&&',$target); -#------------------------- Stack definition (in stack we have all current tags) - my @stack = (); my @parstack = (); - -#------------------------------------- Parse input string (content_file_string) - + &initdepth; 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 - $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 ( $#pars > -1 ) { + while ($token = $pars[$#pars]->get_token) { + if ($token->[0] eq 'T') { + $result=$token->[1]; +# $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)); + &increasedepth($token); + if (exists $style_for_target{$token->[1]}) { + $finaloutput .= &recurse($style_for_target{$token->[1]}, + $target,$safeeval,\%style_for_target, + @parstack); + } else { + $result = &callsub("start_$token->[1]", $target, $token,\@parstack, + \@pars, $safeeval, \%style_for_target); + } + } 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);} - 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 - $finaloutput .= &Apache::run::evaluate($partstring,$safeeval, - $parstack[$#parstack].$innerparstack[$#innerparstack]); - if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; } + 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); + } + } + if ($result ne "" ) { + if ( $#parstack > -1 ) { + $finaloutput .= &Apache::run::evaluate($result,$safeeval, + $parstack[$#parstack]); + } else { + $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); } - } else { - my $result = &callsub("end_$token->[1]", $target, $token, \@parstack, - $pars,$safeeval); - $finaloutput .= &Apache::run::evaluate($result,$safeeval, - $parstack[$#parstack]); + $result = ''; } - pop @stack; - pop @parstack; + if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);} } + pop @pars; } return $finaloutput; } +sub recurse { + + my @innerstack = (); + my @innerparstack = (); + my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_; + my @pat = (); + push (@pat,HTML::TokeParser->new(\$newarg)); + my $tokenpat; + my $partstring = ''; + my $output=''; + my $decls=''; + while ( $#pat > -1 ) { + while ($tokenpat = $pat[$#pat]->get_token) { + if ($tokenpat->[0] eq 'T') { + $partstring = $tokenpat->[1]; + } elsif ($tokenpat->[0] eq 'S') { + push (@innerstack,$tokenpat->[1]); + push (@innerparstack,&parstring($tokenpat)); + &increasedepth($tokenpat); + $partstring = &callsub("start_$tokenpat->[1]", + $target, $tokenpat, \@innerparstack, + \@pat, $safeeval, $style_for_target); + } elsif ($tokenpat->[0] eq 'E') { + #clear out any tags that didn't end + while ($tokenpat->[1] ne $innerstack[$#innerstack] + && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack; + &decreasedepth($tokenpat);} + $partstring = &callsub("end_$tokenpat->[1]", + $target, $tokenpat, \@innerparstack, + \@pat, $safeeval, $style_for_target); + } + #pass both the variable to the style tag, and the tag we + #are processing inside the + 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);} + } + pop @pat; + } + return $output; +} + sub callsub { - my ($sub,$target,$token,$parstack,$parser,$safeeval)=@_; + my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_; 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); + $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); + $currentstring = &$sub($target,$token,$parstack,$parser, + $safeeval,$style); } else { - print "NOT Calling sub $sub\n"; + #print "NOT Calling sub $sub\n"; if (defined($token->[4])) { $currentstring = $token->[4]; } else { @@ -168,6 +182,54 @@ sub callsub { 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 "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]
\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 "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]
\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 { my ($token) = @_; my $temp='';