--- loncom/xml/lonxml.pm 2000/07/20 15:37:54 1.12 +++ loncom/xml/lonxml.pm 2000/08/03 19:34:11 1.16 @@ -8,6 +8,7 @@ package Apache::lonxml; use strict; use HTML::TokeParser; use Safe; +use Opcode; sub register { my $space; @@ -29,135 +30,137 @@ use Apache::scripttag; sub xmlparse { my ($target,$content_file_string,%style_for_target) = @_; - my $pars = HTML::TokeParser->new(\$content_file_string); + 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"); #-------------------- 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 - $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]"}; - -# print "qqq: $token->[1],$newarg\n"; - - my $pat = HTML::TokeParser->new(\$newarg); - my $tokenpat; - my $partstring = ''; + print $#pars; + 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)); - 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 { + my $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;} + + 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); } - } else { - my $result = &callsub("end_$token->[1]", $target, $token, \@parstack, - $pars,$safeeval); - $finaloutput .= &Apache::run::evaluate($result,$safeeval, - $parstack[$#parstack]); } - pop @stack; - pop @parstack; + if ($result ne "" ) { + if ( $#parstack > -1 ) { + $finaloutput .= &Apache::run::evaluate($result,$safeeval, + $parstack[$#parstack]); + } else { + $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); + } + $result = ''; + } + if ($token->[0] eq 'E') { pop @stack;pop @parstack; } } + 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)); + $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;} + $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; } + } + 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); + $currentstring = &$sub($target,$token,$parstack,$parser, + $safeeval,$style); } else { #print "NOT Calling sub $sub\n"; if (defined($token->[4])) {