7 package XML::TemplateSAX::Handler;
8 use base qw(XML::SAX::Base);
15 obj => $options{'Content'},
17 Handler => $options{'Handler'}
24 my ($self, $data) = @_;
25 my $obj = $self->{'obj'};
28 my $id = $data->{'Attributes'}->{'{http://template.sesse.net/}id'};
29 $id = $id->{'Value'} if (defined($id));
31 # substitution: see if this element matches anything. if so,
32 # descend down into the tree.
33 if (ref($obj) eq 'HASH') {
34 # first of all, see if we have an attribute match.
35 for my $key (keys %$obj) {
36 next unless ($key =~ /^(#?)(.*)\/(.*)$/);
37 my ($idmarker, $name, $attr) = ($1, $2, $3);
39 if (($idmarker eq '#' && $id eq $name) ||
40 ($idmarker ne '#' && $data->{'LocalName'} eq $name)) {
41 $data->{'Attributes'}->{$attr} = {
52 for my $key (keys %$obj) {
53 if ($key =~ /^#(.*)$/) {
54 if (defined($id) && $id eq $1) {
55 $match = $obj->{$key};
59 if ($data->{'LocalName'} eq $key) {
60 $match = $obj->{$key};
66 if (defined($match)) {
67 $self->SUPER::start_element($data);
69 push @{$self->{'stack'}}, [ $data->{'Name'}, 0, $obj ];
72 # This is sort of ugly. We special-case replacement by outputting
73 # the string immediately, and then just ignoring the rest of the
74 # events until we get to the right end tag. It's not 100% technically
75 # correct for the case where you replace an entire document by a
76 # string, but that's nonsensical anyway.
79 $self->SUPER::characters({ Data => $match });
80 $self->{'obj'} = undef;
85 # Sort of the same, for cloning. Cloning works by gobbling up all the all the
86 # input until the end element, and put it into a buffer. when we get to the end
87 # element, spew it all out again as many times as we need, onto ourselves so we
88 # get filtering etc. right.
90 # We let the buffer object keep the actual array, so we can fetch it out later.
92 if (ref($match) eq 'ARRAY') {
93 $self->{'obj'} = XML::TemplateSAX::Buffer->new($match);
98 # If someone tries to insert a full tree, do it, just like the character
101 if (ref($match) eq 'XML::TemplateSAX::Buffer') {
102 $match->replay($self);
103 $self->{'obj'} = undef;
106 $self->{'obj'} = $match;
112 # If we have multiple elements with the same name within each other,
113 # we need to keep track of how many there are, so check here and increment.
114 # end_element will decrement and optionally pop the stack.
116 my $stack = $self->{'stack'};
117 if (scalar @$stack > 0) {
118 my $top = $stack->[scalar @$stack - 1];
120 if ($data->{'Name'} eq $top->[0]) {
125 # within a replacement; just ignore everything
126 return if (!defined($obj));
128 # within a cloning; slurp it up
129 if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
130 $obj->start_element($data);
134 $self->SUPER::start_element($data);
138 my ($self, $data) = @_;
140 return if (!defined($self->{'obj'}));
142 if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
143 $self->{'obj'}->characters($data);
147 $self->SUPER::characters($data);
151 my ($self, $data) = @_;
153 return if (!defined($self->{'obj'}));
155 if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
156 $self->{'obj'}->comment($data);
160 $self->SUPER::comment($data);
163 sub processing_instruction {
164 my ($self, $data) = @_;
166 return if (!defined($self->{'obj'}));
168 if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
169 $self->{'obj'}->processing_instruction($data);
173 $self->SUPER::processing_instruction($data);
177 my ($self, $data) = @_;
179 my $stack = $self->{'stack'};
180 if (scalar @$stack > 0) {
181 my $top = $stack->[scalar @$stack - 1];
183 if ($data->{'Name'} eq $top->[0]) {
184 if ($top->[1] == 0) {
185 my $obj = $self->{'obj'};
187 # did we just finish a clone operation?
188 if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
189 for my $instance (@{$obj->{'ptr'}}) {
190 $self->{'obj'} = $instance;
195 $self->SUPER::end_element($data);
196 $self->{'obj'} = $top->[2];
205 return if (!defined($self->{'obj'}));
207 if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
208 $self->{'obj'}->end_element($data);
212 $self->SUPER::end_element($data);