Add deferred parsing for perl-sax. Doesn't work yet, though, so it uses

[xml-template] / perl-sax / XML / TemplateSAX / Handler.pm

diff --git a/perl-sax/XML/TemplateSAX/Handler.pm b/perl-sax/XML/TemplateSAX/Handler.pm
index b7917bc7979b2101156ab4525f3d6c5ff405cf74..319883bfd6ad883938bbab26d64a42bc5d6352ed 100644 (file)
--- a/perl-sax/XML/TemplateSAX/Handler.pm
+++ b/perl-sax/XML/TemplateSAX/Handler.pm
@@ -14,6 +14,7 @@ sub new {
        my $self = {
                obj => $options{'Content'},
                stack => [],
+               level => 0,
                Handler => $options{'Handler'}
        };
        bless($self, $class);
@@ -23,11 +24,22 @@ sub new {
 sub start_element {
        my ($self, $data) = @_;
        my $obj = $self->{'obj'};
-       
+
+       ++$self->{'level'};
+
        # find the ID, if any
        my $id = $data->{'Attributes'}->{'{http://template.sesse.net/}id'};
        $id = $id->{'Value'} if (defined($id));
 
+       # within a replacement; just ignore everything  
+       return if (!defined($obj));
+
+       # within a cloning; slurp it up
+       if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
+               $obj->start_element($data);
+               return;
+       }
+
        # substitution: see if this element matches anything. if so,
        # descend down into the tree.
        if (ref($obj) eq 'HASH') {
@@ -66,7 +78,7 @@ sub start_element {
                if (defined($match)) {
                        $self->SUPER::start_element($data);
                
-                       push @{$self->{'stack'}}, [ $data->{'Name'}, 0, $obj ];
+                       push @{$self->{'stack'}}, [ $self->{'level'}, $obj ];
 
                        #
                        # This is sort of ugly. We special-case replacement by outputting
@@ -101,35 +113,16 @@ sub start_element {
                        if (ref($match) eq 'XML::TemplateSAX::Buffer') {
                                $match->replay($self);
                                $self->{'obj'} = undef;
+                       } elsif (ref($match) eq 'XML::TemplateSAX::Deferred') {
+                               $match->parse($self);
+                               $self->{'obj'} = undef;
+                       } else {
+                               $self->{'obj'} = $match;
                        }
-                       
-                       $self->{'obj'} = $match;
                        return;
                }
        }
        
-       # 
-       # If we have multiple elements with the same name within each other,
-       # we need to keep track of how many there are, so check here and increment.
-       # end_element will decrement and optionally pop the stack.
-       #
-       my $stack = $self->{'stack'};
-       if (scalar @$stack > 0) {
-               my $top = $stack->[scalar @$stack - 1];
-
-               if ($data->{'Name'} eq $top->[0]) {
-                       ++$top->[1];
-               }
-       }
-
-       # within a replacement; just ignore everything  
-       return if (!defined($obj));
-
-       # within a cloning; slurp it up
-       if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
-               $obj->start_element($data);
-               return;
-       }
 
        $self->SUPER::start_element($data);
 }
@@ -180,28 +173,27 @@ sub end_element {
        if (scalar @$stack > 0) {
                my $top = $stack->[scalar @$stack - 1];
                
-               if ($data->{'Name'} eq $top->[0]) {
-                       if ($top->[1] == 0) {
-                               my $obj = $self->{'obj'};
-
-                               # did we just finish a clone operation?
-                               if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
-                                       for my $instance (@{$obj->{'ptr'}}) {
-                                               $self->{'obj'} = $instance;
-                                               $obj->replay($self);
-                                       }
+               if ($self->{'level'} == $top->[0]) {
+                       my $obj = $self->{'obj'};
+
+                       # did we just finish a clone operation?
+                       if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
+                               for my $instance (@{$obj->{'ptr'}}) {
+                                       $self->{'obj'} = $instance;
+                                       $obj->replay($self);
                                }
-
-                               $self->SUPER::end_element($data);
-                               $self->{'obj'} = $top->[2];
-                               pop @$stack;
-                               return;
-                       } else {
-                               --$top->[1];
                        }
+
+                       $self->SUPER::end_element($data);
+                       $self->{'obj'} = $top->[1];
+                       pop @$stack;
+                       --$self->{'level'};
+                       return;
                }
        }
        
+       --$self->{'level'};
+       
        return if (!defined($self->{'obj'}));
        
        if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {