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

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