--- loncom/xml/lonxml.pm 2000/08/02 16:47:53 1.14 +++ loncom/xml/lonxml.pm 2000/08/11 14:24:50 1.18 @@ -29,133 +29,132 @@ 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"); + 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, \%style_for_target); - } 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, \%style_for_target); - } - #pass both the variable to the style tag, and the tag we - #are processing inside the - if ($partstring ne "" ) { - $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, \%style_for_target); - if ($result ne "" ) { - $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(); + 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;} - 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, \%style_for_target); - } 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, \%style_for_target); - } - #pass both the variable to the style tag, and the tag we - #are processing inside the - if ( $partstring ne "" ) { - $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); } - } else { - my $result = &callsub("end_$token->[1]", $target, $token, \@parstack, - $pars,$safeeval, \%style_for_target); - if ($result ne "") { + } + if ($result ne "" ) { + if ( $#parstack > -1 ) { $finaloutput .= &Apache::run::evaluate($result,$safeeval, $parstack[$#parstack]); + } else { + $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); } + $result = ''; } - pop @stack; - pop @parstack; + if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth;} } + 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(); + $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;} + $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;} + } + pop @pat; + } + return $output; +} + sub callsub { my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; @@ -164,7 +163,9 @@ sub callsub { 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,$style); + $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); + $currentstring = &$sub($target,$token,$parstack,$parser, + $safeeval,$style); } else { #print "NOT Calling sub $sub\n"; if (defined($token->[4])) { @@ -178,6 +179,28 @@ sub callsub { return $currentstring; } +sub initdepth { + @Apache::lonxml::depthcounter=(); + $Apache::lonxml::depth=-1; + $Apache::lonxml::olddepth=-1; +} + +sub increasedepth { + if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { + $#Apache::lonxml::depthcounter--; + $Apache::lonxml::olddepth=$Apache::lonxml::depth; + } + $Apache::lonxml::depth++; + $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; + if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { + $Apache::lonxml::olddepth=$Apache::lonxml::depth; + } +} + +sub decreasedepth { + $Apache::lonxml::depth--; +} + sub parstring { my ($token) = @_; my $temp='';