git.sesse.net Git - xml-template/blob - perl-sax/XML/TemplateSAX/Handler.pm

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Data::Dumper;
   6
   7 package XML::TemplateSAX::Handler;
   8 use base qw(XML::SAX::Base);
   9
  10 sub new {
  11         my $class = shift;
  12         my %options = @_;
  13
  14         my $self = {
  15                 obj => $options{'Content'},
  16                 stack => [],
  17                 Handler => $options{'Handler'}
  18         };
  19         bless($self, $class);
  20         return $self;
  21 }
  22
  23 sub start_element {
  24         my ($self, $data) = @_;
  25         my $obj = $self->{'obj'};
  26
  27         # find the ID, if any
  28         my $id = $data->{'Attributes'}->{'{http://template.sesse.net/}id'};
  29         $id = $id->{'Value'} if (defined($id));
  30
  31         # within a replacement; just ignore everything
  32         return if (!defined($obj));
  33
  34         # within a cloning; slurp it up
  35         if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
  36                 $obj->start_element($data);
  37                 return;
  38         }
  39
  40         # substitution: see if this element matches anything. if so,
  41         # descend down into the tree.
  42         if (ref($obj) eq 'HASH') {
  43                 my $match = undef;
  44                 for my $key (keys %$obj) {
  45                         if ($key =~ /^#(.*)$/) {
  46                                 if (defined($id) && $id eq $1) {
  47                                         $match = $obj->{$key};
  48                                         last;
  49                                 }
  50                         } else {
  51                                 if ($data->{'LocalName'} eq $key) {
  52                                         $match = $obj->{$key};
  53                                         last;
  54                                 }
  55                         }
  56                 }
  57
  58                 if (defined($match)) {
  59                         $self->SUPER::start_element($data);
  60
  61                         # FIXME: we should match on something better than the name. But what?
  62                         push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];
  63
  64                         #
  65                         # This is sort of ugly. We special-case replacement by outputting
  66                         # the string immediately, and then just ignoring the rest of the
  67                         # events until we get to the right end tag. It's not 100% technically
  68                         # correct for the case where you replace an entire document by a
  69                         # string, but that's nonsensical anyway.
  70                         #
  71                         if (!ref($match)) {
  72                                 $self->SUPER::characters({ Data => $match });
  73                                 $self->{'obj'} = undef;
  74                                 return;
  75                         }
  76
  77                         #
  78                         # Sort of the same, for cloning. Cloning works by gobbling up all the all the
  79                         # input until the end element, and put it into a buffer. when we get to the end
  80                         # element, spew it all out again as many times as we need, onto ourselves so we
  81                         # get filtering etc. right.
  82                         #
  83                         # We let the buffer object keep the actual array, so we can fetch it out later.
  84                         #
  85                         if (ref($match) eq 'ARRAY') {
  86                                 $self->{'obj'} = XML::TemplateSAX::Buffer->new($match);
  87                                 return;
  88                         }
  89
  90                         #
  91                         # If someone tries to insert a full tree, do it, just like the character
  92                         # replacement above.
  93                         #
  94                         if (ref($match) eq 'XML::TemplateSAX::Buffer') {
  95                                 $match->replay($self);
  96                                 $self->{'obj'} = undef;
  97                         }
  98
  99                         $self->{'obj'} = $match;
 100                         return;
 101                 }
 102         }
 103
 104
 105         $self->SUPER::start_element($data);
 106 }
 107
 108 sub characters {
 109         my ($self, $data) = @_;
 110
 111         return if (!defined($self->{'obj'}));
 112
 113         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 114                 $self->{'obj'}->characters($data);
 115                 return;
 116         }
 117
 118         $self->SUPER::characters($data);
 119 }
 120
 121 sub comment {
 122         my ($self, $data) = @_;
 123
 124         return if (!defined($self->{'obj'}));
 125
 126         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 127                 $self->{'obj'}->comment($data);
 128                 return;
 129         }
 130
 131         $self->SUPER::comment($data);
 132 }
 133
 134 sub processing_instruction {
 135         my ($self, $data) = @_;
 136
 137         return if (!defined($self->{'obj'}));
 138
 139         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 140                 $self->{'obj'}->processing_instruction($data);
 141                 return;
 142         }
 143
 144         $self->SUPER::processing_instruction($data);
 145 }
 146
 147 sub end_element {
 148         my ($self, $data) = @_;
 149
 150         my $stack = $self->{'stack'};
 151         if (scalar @$stack > 0) {
 152                 my $top = $stack->[scalar @$stack - 1];
 153
 154                 if ($data->{'Name'} eq $top->[0]) {
 155                         my $obj = $self->{'obj'};
 156
 157                         # did we just finish a clone operation?
 158                         if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
 159                                 for my $instance (@{$obj->{'ptr'}}) {
 160                                         $self->{'obj'} = $instance;
 161                                         $obj->replay($self);
 162                                 }
 163                         }
 164
 165                         $self->SUPER::end_element($data);
 166                         $self->{'obj'} = $top->[1];
 167                         pop @$stack;
 168                         return;
 169                 }
 170         }
 171
 172         return if (!defined($self->{'obj'}));
 173
 174         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 175                 $self->{'obj'}->end_element($data);
 176                 return;
 177         }
 178
 179         $self->SUPER::end_element($data);
 180 }
 181
 182 1;