4 # SAX version of XML::Template. Advantages over DOM: Doesn't have to load
5 # the entire thing into memory, and you can chain filters. Disadvantages:
6 # Slightly kludgier interface.
8 # Differences from the DOM version:
10 # - There is no process(). Instead, it works as a SAX filter, so you put it
11 # in the stream, usually between a parser and a writer (ie.
12 # parser -> XML::TemplateSAX::Handler -> writer). process_file works as
13 # before, but it returns a _string_, not a DOM tree.
14 # - You can no longer insert a DOM tree. Instead, what you have is -- FIXME:
22 package XML::TemplateSAX::Handler;
23 use base qw(XML::SAX::Base);
30 obj => $options{'Content'},
32 Handler => $options{'Handler'}
39 my ($self, $data) = @_;
40 my $obj = $self->{'obj'};
42 # within a replacement; just ignore everything
43 return if (!defined($obj));
45 # substitution: see if this element matches anything. if so,
46 # descend down into the tree.
47 if (ref($obj) eq 'HASH') {
49 for my $key (keys %$obj) {
50 if ($key =~ /^#(.*)$/) {
51 if ($data->{'NamespaceURI'} eq 'http://template.sesse.net/' && $data->{'LocalName'} eq $1) {
52 $match = $obj->{$key};
56 if ($data->{'LocalName'} eq $key) {
57 $match = $obj->{$key};
63 if (defined($match)) {
64 $self->SUPER::start_element($data);
66 push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];
69 # This is sort of ugly. We special-case replacement by outputting
70 # the string immediately, and then just ignoring the rest of the
71 # events until we get to the right end tag. It's not 100% technically
72 # correct for the case where you replace an entire document by a
73 # string, but that's nonsensical anyway.
76 $self->SUPER::characters({ Data => $match });
80 $self->{'obj'} = $match;
85 $self->SUPER::start_element($data);
89 my ($self, $data) = @_;
90 return if (!defined($self->{'obj'}));
91 $self->SUPER::characters($data);
95 my ($self, $data) = @_;
97 my $stack = $self->{'stack'};
98 if (scalar @$stack > 0) {
99 my $top = $stack->[$#stack];
101 if ($data->{'Name'} eq $top->[0]) {
102 $self->SUPER::end_element($data);
103 $self->{'obj'} = $top->[1];
109 return if (!defined($self->{'obj'}));
111 $self->SUPER::end_element($data);
114 package XML::TemplateSAX::Cleaner;
115 use base qw(XML::SAX::Base);
118 my ($self, $data) = @_;
119 my $attrs = $data->{'Attributes'};
121 for my $a (keys %$attrs) {
122 if ($attrs->{$a}->{'NamespaceURI'} eq 'http://template.sesse.net/') {
127 $self->SUPER::start_element($data);
130 package XML::TemplateSAX;
133 my ($filename, $obj, $clean) = @_;
134 $clean = 1 unless (defined($clean));
136 my ($writer, $cleaner, $filter, $parser);
139 # FIXME: hardcoding expat = not good?
140 $writer = XML::SAX::Writer->new(Output => \$str);
143 $cleaner = XML::TemplateSAX::Cleaner->new(Handler => $writer, Content => $obj);
144 $filter = XML::TemplateSAX::Handler->new(Handler => $cleaner, Content => $obj);
146 $filter = XML::TemplateSAX::Handler->new(Handler => $writer, Content => $obj);
149 $parser = XML::SAX::Expat->new(Handler => $filter);
150 $parser->parse_file($filename);