File Coverage

blib/lib/Simple/SAX/Serializer/Parser.pm
Criterion Covered Total %
statement 49 49 100.0
branch 9 10 90.0
condition 3 4 75.0
subroutine 11 11 100.0
pod 6 6 100.0
total 78 80 97.5


line stmt bran cond sub pod time code
1             package Simple::SAX::Serializer::Parser;
2              
3 3     3   20 use warnings;
  3         6  
  3         121  
4 3     3   25 use strict;
  3         7  
  3         125  
5 3     3   15 use vars qw($VERSION);
  3         5  
  3         204  
6              
7             $VERSION = 0.03;
8              
9 3     3   18 use base 'XML::SAX::Base';
  3         7  
  3         241  
10 3     3   1828 use Simple::SAX::Serializer::Element;
  3         8  
  3         1528  
11              
12             =head1 NAME
13              
14             Simple::SAX::Serializer::Parser - Xml parser
15              
16             =head1 DESCRIPTION
17              
18             Represents xml parser.
19              
20             =head1 SYNOPSIS
21              
22             use Simple::SAX::Serializer;
23             my $xml = Simple::SAX::Serializer->new(file_name => 'dummy.xml')
24              
25             $xml->handler('root/child', sub {
26             my ($self, $element, $parent) = @_;
27             my $attributes = $element->attributes;
28             my $result = $parent->children_result;
29             $result = $parent->result([])
30             unless $result;
31             push @$result,Child->new(%$attributes);
32             });
33              
34             =head2 METHODS
35              
36             =over
37              
38             =item start_document
39              
40             Handles the start of the document. Sets up state for the parse.
41              
42             =cut
43              
44             sub start_document {
45 14     14 1 3329 my ($self) = @_;
46 14         36 $self->{args} = [];
47 14         58 $self->{elements} = [];
48             }
49              
50              
51             =item start_element
52              
53             Handles the start of an element.
54              
55             =cut
56              
57             sub start_element {
58 65     65 1 33633 my ($self, $element) = @_;
59 65         96 my $elements = $self->{elements};
60 65         73 push @{$elements}, [$element->{LocalName} => attributes($element), undef, ''];
  65         152  
61 65         213 $self->{elements};
62             }
63              
64             =item attributes
65              
66             =cut
67              
68             sub attributes {
69 65     65 1 75 my ($element) = @_;
70 65         73 my %result;
71 65         71 foreach my $k (keys %{$element->{Attributes}}) {
  65         186  
72 65         100 my $attr = $element->{Attributes}->{$k};
73 65         95 my $prefix = $attr->{Prefix};
74 65 100       118 if($prefix) {
75 12   50     76 $result{"_${prefix}"}{$attr->{LocalName}} ||= {};
76 12         45 $result{"_${prefix}"}{$attr->{LocalName}} = $attr->{Value};
77            
78             } else {
79 53         172 $result{$attr->{LocalName}} = $attr->{Value};
80             }
81             }
82 65         230 \%result;
83             }
84              
85             =item characters
86              
87             Handles text data in the document.
88              
89             =cut
90              
91             sub characters {
92 79     79 1 3809 my ($self, $data) = @_;
93 79         124 my $current_element = $self->{elements}->[-1];
94 79         253 $current_element->[-1] .= $data->{Data};
95             }
96              
97              
98             =item end_element
99              
100             Handles a closing tag.
101              
102             =cut
103              
104             my $element = Simple::SAX::Serializer::Element->new;
105             my $parent = Simple::SAX::Serializer::Element->new;
106              
107             sub end_element {
108 64     64 1 3575 my ($self, $sax_element) = @_;
109 64         165 my $elements = $self->{elements};
110 64         84 my $args = $self->{args};
111            
112 64 50       217 if (my $callback = $self->{parser}->find_handlder($elements)) {
113 63         195 $element->set_node($elements->[-1]);
114 63 100       875 $parent->set_node($elements->[-2]) if (@$elements > 1);
115 63 100       687 my $result = $callback->(
116             $self,
117             $element,
118             (@$elements > 1 ? $parent : ())
119             );
120 63 100       2104 $self->{result} = $result if @$elements == 1;
121             }
122 63         82 pop @$args;
123 63         177 pop @$elements;
124             }
125              
126              
127             =item root_args
128              
129             Returns parse parameters.
130             $xml->parse_string($xml_content, {root_param1 => 1, root_param2 => 2;});
131              
132             =cut
133              
134             sub root_args {
135 6     6 1 13 my ($self) = @_;
136 6   100     40 $self->{root_args} ||= {};
137             }
138             1;
139              
140             __END__