--- loncom/xml/lonxml.pm 2000/06/29 13:58:23 1.6 +++ loncom/xml/lonxml.pm 2000/08/03 18:24:24 1.15 @@ -8,10 +8,23 @@ package Apache::lonxml; use strict; use HTML::TokeParser; use Safe; +use Opcode; + +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::londefdef; use Apache::run; +use Apache::londefdef; +use Apache::scripttag; #================================================== Main subroutine: xmlparse sub xmlparse { @@ -21,10 +34,9 @@ sub xmlparse { my $currentstring = ''; my $finaloutput = ''; my $newarg = ''; - my $tempostring = ''; - my $tempocont = ''; 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); @@ -40,156 +52,118 @@ sub xmlparse { while ($token = $pars->get_token) { if ($token->[0] eq 'T') { - $finaloutput .= $token->[1]; - $tempocont .= $token->[1]; + $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,''); } elsif ($token->[0] eq 'S') { -#------------------------------------------------------------- add tag to stack + # add tag to stack push (@stack,$token->[1]); -#----------------------------------------- add parameters list to another stack - map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]}; - push (@parstack,$tempostring); - $tempostring = ''; + # add parameters list to another stack + push (@parstack,&parstring($token)); if (exists $style_for_target{$token->[1]}) { -# print "Style for $token->[1] is " .$style_for_target{$token->[1]}."\n"; -#---------------------------------------------------- use style file definition - - $newarg = $style_for_target{$token->[1]}; - - if (index($newarg,'script') != -1 ) { - my $pat = HTML::TokeParser->new(\$newarg); - my $tokenpat = ''; - my $partstring = ''; - my $oustring = ''; - my $outputstring; - - while ($tokenpat = $pat->get_token) { - if ($tokenpat->[0] eq 'T') { -# print "evaluating $tokenpat->[4]\n"; - $oustring .= &Apache::run::evaluate($tokenpat->[1],$safeeval); - } elsif ($tokenpat->[0] eq 'S') { - if ($tokenpat->[1] eq 'script') { - while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { - if ($tokenpat->[0] eq 'S') { - $partstring .= $tokenpat->[4]; - } elsif ($tokenpat->[0] eq 'T') { - $partstring .= $tokenpat->[1]; - } elsif ($tokenpat->[0] eq 'E') { - $partstring .= $tokenpat->[2]; - } - } - - map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; -# print "want to use run\n"; - &Apache::run::run($partstring,$safeeval); - - $partstring = ''; - } else { -# print "evaluating $tokenpat->[4]\n"; - $oustring .= &Apache::run::evaluate($tokenpat->[4],$safeeval); - } - } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') { -# print "hereish\n"; - $oustring .= $tokenpat->[1]; - } - } - $newarg = $oustring; - } else { - map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; - } - $finaloutput .= $newarg; + $finaloutput .= &recurse($style_for_target{$token->[1]}, + $target,$safeeval,\%style_for_target, + @parstack); } else { - # use default definition of tag - my $sub="start_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - $currentstring = &$sub($target,$token,\@parstack); - $finaloutput .= $currentstring; - $currentstring = ''; - } else { - $finaloutput .= $token->[4]; - } - use strict 'refs'; + 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') { - # Put here check for correct final tag (to avoid existence of - # starting tag only) - - pop @stack; - unless (exists $style_for_target{$token->[1]}) { - my $sub="end_$token->[1]"; - { - no strict 'refs'; - if (defined(&$sub)) { - $currentstring = &$sub($target,$token,\@parstack); - $finaloutput .= $currentstring; - $currentstring = ''; - } else { - $finaloutput .= $token->[4]; - } - use strict 'refs'; - } - } - #---- end tag from the style file + #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]"}) { - $newarg = $style_for_target{'/'."$token->[1]"}; - if (index($newarg,'script') != -1 ) { - my $pat = HTML::TokeParser->new(\$newarg); - my $tokenpat; - my $partstring = ''; - my $oustring = ''; - my $outputstring; - - while ($tokenpat = $pat->get_token) { - if ($tokenpat->[0] eq 'T') { - $oustring .= $tokenpat->[1]; - } elsif ($tokenpat->[0] eq 'S') { - if ($tokenpat->[1] eq 'script') { - while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { - if ($tokenpat->[0] eq 'S') { - $partstring .= $tokenpat->[4]; - } elsif ($tokenpat->[0] eq 'T') { - $partstring .= $tokenpat->[1]; - } elsif ($tokenpat->[0] eq 'E') { - $partstring .= $tokenpat->[2]; - } - } - - my @tempor_list = split(',',$parstack[$#parstack]); - my @te_kl = (); - my %tempor_hash = (); - map {(my $onete,my $twote) = split('=',$_); push (@te_kl,$onete); - $tempor_hash{$onete} = $twote} @tempor_list; - map {$partstring =~ s/\$$_/$tempor_hash{$_}/g; } @te_kl; - print "want to use run\n"; - &Apache::run::run($partstring,$safeeval); - - $partstring = ''; - } elsif ($tokenpat->[1] eq 'evaluate') { - $outputstring = &Apache::run::evaluate($tokenpat->[2]{expression},$safeeval); - $oustring .= $outputstring; - } else { - $oustring .= $tokenpat->[4]; - } - } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') { - $oustring .= $tokenpat->[1]; - } - } - $newarg = $oustring; - } else { - my @very_temp = split(',',$parstack[$#parstack]); - map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp; + $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, + $parstack[$#parstack]); } - - $finaloutput .= $newarg; } + pop @stack; pop @parstack; } } return $finaloutput; } +sub recurse { + + my @innerstack = (); + my @innerparstack = (); + my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_; + my $pat = HTML::TokeParser->new(\$newarg); + my $tokenpat; + my $partstring = ''; + my $output=''; + 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 "" ) { + $output .= &Apache::run::evaluate($partstring,$safeeval, + $parstack[$#parstack].$innerparstack[$#innerparstack]); + } + if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; } + } + return $output; +} + +sub callsub { + 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,$style); + } 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__ + + + + +