File Coverage

blib/lib/XML/Elemental/SAXHandler.pm
Criterion Covered Total %
statement 55 57 96.4
branch 3 6 50.0
condition 5 10 50.0
subroutine 11 11 100.0
pod 5 6 83.3
total 79 90 87.7


line stmt bran cond sub pod time code
1             package XML::Elemental::SAXHandler;
2 3     3   1980 use strict;
  3         9  
  3         133  
3 3     3   18 use warnings;
  3         6  
  3         131  
4              
5 3     3   15 use vars qw($VERSION);
  3         16  
  3         234  
6             $VERSION = '0.11';
7              
8 3     3   19 use base qw( XML::SAX::Base );
  3         5  
  3         5022  
9              
10 3     3   84788 use Scalar::Util qw(weaken);
  3         9  
  3         3101  
11              
12             my %defaults = (
13             Document => 'XML::Elemental::Document',
14             Element => 'XML::Elemental::Element',
15             Characters => 'XML::Elemental::Characters'
16             );
17              
18             # We work with direct references to the underlying HASH data
19             # rather then the methods for better parsing performance.
20             # Dangerous? Perhaps.
21              
22             sub new {
23 4     4 0 844 my $self = shift->SUPER::new(@_);
24 4         353 for (keys %defaults) {
25 12   66     103 $self->{$_} ||= $defaults{$_};
26 12 50       912 eval "require " . $self->{$_} or die $@;
27             }
28 4         36 $self;
29             }
30              
31             sub start_document {
32 3     3 1 237966 my ($self, $doc) = @_;
33 3         50 $self->{__doc} = $self->{Document}->new;
34 3         6 push(@{$self->{__stack}}, $self->{__doc});
  3         21  
35             }
36              
37             sub start_element {
38 15     15 1 14968 my ($self, $e) = @_;
39 15   100     78 my $ns = $e->{NamespaceURI} || '';
40 15         76 my $node = $self->{Element}->new;
41 15         62 $node->{name} = "{$ns}" . $e->{LocalName};
42 15         38 $node->{parent} = $self->{__stack}->[-1];
43 15 50       41 if ($e->{Attributes}) {
44 15         20 my %attr;
45 18         69 map { $attr{$_} = $e->{Attributes}->{$_}->{Value} }
  15         47  
46 15         27 keys %{$e->{Attributes}};
47 15         45 $node->{attributes} = \%attr;
48             }
49 15         24 push(@{$node->{parent}->{contents}}, $node);
  15         50  
50 15         32 push(@{$self->{__stack}}, $node);
  15         64  
51             }
52              
53             sub characters {
54 24     24 1 1686 my ($self, $data) = @_;
55 24         48 my $parent = $self->{__stack}->[-1];
56 24         34 my $contents = $parent->{contents};
57 24         40 my $class = $self->{Characters};
58 24 50 33     559 unless ($contents && ref($contents->[-1]) eq $class) {
59 24         102 my $node = $class->new;
60 24         72 $node->{parent} = $parent;
61 24         56 $node->{data} = $data->{Data};
62 24         28 push(@{$contents}, $node);
  24         98  
63             }
64             else {
65 0   0     0 my $d = $contents->[-1]->data || '';
66 0         0 $contents->[-1]->data($d . $data->{Data});
67             }
68             }
69              
70 15     15 1 1844 sub end_element { pop(@{$_[0]->{__stack}}) }
  15         59  
71              
72             sub end_document {
73 3     3 1 337 delete $_[0]->{__stack};
74 3         13 $_[0]->{__doc}->{contents} = $_[0]->{__doc}->{contents}->[0];
75 3         23 weaken($_[0]->{__doc}->{contents}->{parent} = $_[0]->{__doc});
76 3         84 $_[0]->{__doc};
77             }
78              
79             1;
80              
81             __END__