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         # 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);
  38
  39                         if (($idmarker eq '#' && $id eq $name) ||
  40                             ($idmarker ne '#' && $data->{'LocalName'} eq $name)) {
  41                                 $data->{'Attributes'}->{$attr} = {
  42                                         Prefix => '',
  43                                         LocalName => $attr,
  44                                         Name => $attr,
  45                                         NamespaceURI => '',
  46                                         Value => $obj->{$key}
  47                                 };
  48                         }
  49                 }
  50
  51                 my $match = undef;
  52                 for my $key (keys %$obj) {
  53                         if ($key =~ /^#(.*)$/) {
  54                                 if (defined($id) && $id eq $1) {
  55                                         $match = $obj->{$key};
  56                                         last;
  57                                 }
  58                         } else {
  59                                 if ($data->{'LocalName'} eq $key) {
  60                                         $match = $obj->{$key};
  61                                         last;
  62                                 }
  63                         }
  64                 }
  65
  66                 if (defined($match)) {
  67                         $self->SUPER::start_element($data);
  68
  69                         push @{$self->{'stack'}}, [ $data->{'Name'}, 0, $obj ];
  70
  71                         #
  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.
  77                         #
  78                         if (!ref($match)) {
  79                                 $self->SUPER::characters({ Data => $match });
  80                                 $self->{'obj'} = undef;
  81                                 return;
  82                         }
  83
  84                         #
  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.
  89                         #
  90                         # We let the buffer object keep the actual array, so we can fetch it out later.
  91                         #
  92                         if (ref($match) eq 'ARRAY') {
  93                                 $self->{'obj'} = XML::TemplateSAX::Buffer->new($match);
  94                                 return;
  95                         }
  96
  97                         #
  98                         # If someone tries to insert a full tree, do it, just like the character
  99                         # replacement above.
 100                         #
 101                         if (ref($match) eq 'XML::TemplateSAX::Buffer') {
 102                                 $match->replay($self);
 103                                 $self->{'obj'} = undef;
 104                         }
 105
 106                         $self->{'obj'} = $match;
 107                         return;
 108                 }
 109         }
 110
 111         #
 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.
 115         #
 116         my $stack = $self->{'stack'};
 117         if (scalar @$stack > 0) {
 118                 my $top = $stack->[scalar @$stack - 1];
 119
 120                 if ($data->{'Name'} eq $top->[0]) {
 121                         ++$top->[1];
 122                 }
 123         }
 124
 125         # within a replacement; just ignore everything
 126         return if (!defined($obj));
 127
 128         # within a cloning; slurp it up
 129         if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
 130                 $obj->start_element($data);
 131                 return;
 132         }
 133
 134         $self->SUPER::start_element($data);
 135 }
 136
 137 sub characters {
 138         my ($self, $data) = @_;
 139
 140         return if (!defined($self->{'obj'}));
 141
 142         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 143                 $self->{'obj'}->characters($data);
 144                 return;
 145         }
 146
 147         $self->SUPER::characters($data);
 148 }
 149
 150 sub comment {
 151         my ($self, $data) = @_;
 152
 153         return if (!defined($self->{'obj'}));
 154
 155         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 156                 $self->{'obj'}->comment($data);
 157                 return;
 158         }
 159
 160         $self->SUPER::comment($data);
 161 }
 162
 163 sub processing_instruction {
 164         my ($self, $data) = @_;
 165
 166         return if (!defined($self->{'obj'}));
 167
 168         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 169                 $self->{'obj'}->processing_instruction($data);
 170                 return;
 171         }
 172
 173         $self->SUPER::processing_instruction($data);
 174 }
 175
 176 sub end_element {
 177         my ($self, $data) = @_;
 178
 179         my $stack = $self->{'stack'};
 180         if (scalar @$stack > 0) {
 181                 my $top = $stack->[scalar @$stack - 1];
 182
 183                 if ($data->{'Name'} eq $top->[0]) {
 184                         if ($top->[1] == 0) {
 185                                 my $obj = $self->{'obj'};
 186
 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;
 191                                                 $obj->replay($self);
 192                                         }
 193                                 }
 194
 195                                 $self->SUPER::end_element($data);
 196                                 $self->{'obj'} = $top->[2];
 197                                 pop @$stack;
 198                                 return;
 199                         } else {
 200                                 --$top->[1];
 201                         }
 202                 }
 203         }
 204
 205         return if (!defined($self->{'obj'}));
 206
 207         if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
 208                 $self->{'obj'}->end_element($data);
 209                 return;
 210         }
 211
 212         $self->SUPER::end_element($data);
 213 }
 214
 215 1;