#! /usr/bin/perl
+use strict;
use Data::Dumper;
package XML::TemplateSAX::Handler;
# 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') {
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
#
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;
}
return if (!defined($self->{'obj'}));
+
+ if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
+ $self->{'obj'}->end_element($data);
+ return;
+ }
$self->SUPER::end_element($data);
}