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

   1 #! /usr/bin/perl
   2
   3 use Data::Dumper;
   4
   5 package XML::TemplateSAX::Handler;
   6 use base qw(XML::SAX::Base);
   7
   8 sub new {
   9         my $class = shift;
  10         my %options = @_;
  11
  12         my $self = {
  13                 obj => $options{'Content'},
  14                 stack => [],
  15                 Handler => $options{'Handler'}
  16         };
  17         bless($self, $class);
  18         return $self;
  19 }
  20
  21 sub start_element {
  22         my ($self, $data) = @_;
  23         my $obj = $self->{'obj'};
  24
  25         # find the ID, if any
  26         my $id = $data->{'Attributes'}->{'{http://template.sesse.net/}id'};
  27         $id = $id->{'Value'} if (defined($id));
  28
  29         # within a replacement; just ignore everything
  30         return if (!defined($obj));
  31
  32         # substitution: see if this element matches anything. if so,
  33         # descend down into the tree.
  34         if (ref($obj) eq 'HASH') {
  35                 my $match = undef;
  36                 for my $key (keys %$obj) {
  37                         if ($key =~ /^#(.*)$/) {
  38                                 if (defined($id) && $id eq $1) {
  39                                         $match = $obj->{$key};
  40                                         last;
  41                                 }
  42                         } else {
  43                                 if ($data->{'LocalName'} eq $key) {
  44                                         $match = $obj->{$key};
  45                                         last;
  46                                 }
  47                         }
  48                 }
  49
  50                 if (defined($match)) {
  51                         $self->SUPER::start_element($data);
  52
  53                         push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];
  54
  55                         #
  56                         # This is sort of ugly. We special-case replacement by outputting
  57                         # the string immediately, and then just ignoring the rest of the
  58                         # events until we get to the right end tag. It's not 100% technically
  59                         # correct for the case where you replace an entire document by a
  60                         # string, but that's nonsensical anyway.
  61                         #
  62                         if (!ref($match)) {
  63                                 $self->SUPER::characters({ Data => $match });
  64                                 $match = undef;
  65                         }
  66
  67                         $self->{'obj'} = $match;
  68                         return;
  69                 }
  70         }
  71
  72         $self->SUPER::start_element($data);
  73 }
  74
  75 sub characters {
  76         my ($self, $data) = @_;
  77         return if (!defined($self->{'obj'}));
  78         $self->SUPER::characters($data);
  79 }
  80
  81 sub end_element {
  82         my ($self, $data) = @_;
  83
  84         my $stack = $self->{'stack'};
  85         if (scalar @$stack > 0) {
  86                 my $top = $stack->[$#stack];
  87
  88                 if ($data->{'Name'} eq $top->[0]) {
  89                         $self->SUPER::end_element($data);
  90                         $self->{'obj'} = $top->[1];
  91                         pop @$stack;
  92                         return;
  93                 }
  94         }
  95
  96         return if (!defined($self->{'obj'}));
  97
  98         $self->SUPER::end_element($data);
  99 }
 100
 101 1;