Almost fix cloning. Yay!

diff --git a/perl-sax/XML/TemplateSAX.pm b/perl-sax/XML/TemplateSAX.pm
index 65f8d226cac07f63fc3d79c395a943fa872a1e20..a0555ec7df7dd7cca89e1615ff806dbdb12d0225 100644 (file)
--- a/perl-sax/XML/TemplateSAX.pm
+++ b/perl-sax/XML/TemplateSAX.pm
@@ -17,6 +17,7 @@
 
 use XML::SAX::Expat;
 use XML::SAX::Writer;
+use XML::TemplateSAX::Buffer;
 use XML::TemplateSAX::Cleaner;
 use XML::TemplateSAX::Handler;
 

diff --git a/perl-sax/XML/TemplateSAX/Buffer.pm b/perl-sax/XML/TemplateSAX/Buffer.pm
index f7a141b64d162b977c0c5555f6dd0f95d956c463..cfae23546dafb4bf8fd1f9c3defd90f99a2eb75a 100644 (file)
--- a/perl-sax/XML/TemplateSAX/Buffer.pm
+++ b/perl-sax/XML/TemplateSAX/Buffer.pm
@@ -8,10 +8,11 @@ use base qw(XML::SAX::Base);
 
 sub new {
        my $class = shift;
-       my %options = @_;
+       my $ptr = shift;
 
        my $self = {
-               events => []
+               events => [],
+               ptr => $ptr
        };
        bless($self, $class);
        return $self;

diff --git a/perl-sax/XML/TemplateSAX/Handler.pm b/perl-sax/XML/TemplateSAX/Handler.pm
index 24371cebe180a5d26e08d3ca0b13fc93cbef7da8..47ba62aa8ee0fdf6d3bfb279a7e525a81dcb6fc9 100644 (file)
--- a/perl-sax/XML/TemplateSAX/Handler.pm
+++ b/perl-sax/XML/TemplateSAX/Handler.pm
@@ -1,5 +1,6 @@
 #! /usr/bin/perl
 
+use strict;
 use Data::Dumper;
 
 package XML::TemplateSAX::Handler;
@@ -29,6 +30,12 @@ sub start_element {
        # 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') {
@@ -49,9 +56,9 @@ sub start_element {
 
                if (defined($match)) {
                        $self->SUPER::start_element($data);
-
-                       push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];
                        
+                       push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];
+
                        #
                        # This is sort of ugly. We special-case replacement by outputting
                        # the string immediately, and then just ignoring the rest of the
@@ -61,31 +68,89 @@ sub start_element {
                        #
                        if (!ref($match)) {
                                $self->SUPER::characters({ Data => $match });
-                               $match = undef;
+                               $self->{'obj'} = undef;
+                               return;
                        }
 
+                       #
+                       # Sort of the same, for cloning. Cloning works by gobbling up all the all the
+                       # input until the end element, and put it into a buffer. when we get to the end
+                       # element, spew it all out again as many times as we need, onto ourselves so we
+                       # get filtering etc. right.
+                       #
+                       # We let the buffer object keep the actual array, so we can fetch it out later.
+                       #
+                       if (ref($match) eq 'ARRAY') {
+                               $self->{'obj'} = XML::TemplateSAX::Buffer->new($match);
+                               return;
+                       }
+                       
                        $self->{'obj'} = $match;
                        return;
                }
        }
        
+
        $self->SUPER::start_element($data);
 }
 
 sub characters {
        my ($self, $data) = @_;
+
        return if (!defined($self->{'obj'}));
+       
+       if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
+               $self->{'obj'}->characters($data);
+               return;
+       }
+
        $self->SUPER::characters($data);
 }
 
+sub comment {
+       my ($self, $data) = @_;
+
+       return if (!defined($self->{'obj'}));
+       
+       if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
+               $self->{'obj'}->comment($data);
+               return;
+       }
+
+       $self->SUPER::comment($data);
+}
+
+sub processing_instruction {
+       my ($self, $data) = @_;
+
+       return if (!defined($self->{'obj'}));
+       
+       if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
+               $self->{'obj'}->processing_instruction($data);
+               return;
+       }
+
+       $self->SUPER::processing_instruction($data);
+}
+
 sub end_element {
        my ($self, $data) = @_;
 
        my $stack = $self->{'stack'};
        if (scalar @$stack > 0) {
-               my $top = $stack->[$#stack];
+               my $top = $stack->[scalar @$stack - 1];
                
                if ($data->{'Name'} eq $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->[1];
                        pop @$stack;
@@ -94,6 +159,11 @@ sub end_element {
        }
        
        return if (!defined($self->{'obj'}));
+       
+       if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
+               $self->{'obj'}->end_element($data);
+               return;
+       }
 
        $self->SUPER::end_element($data);
 }