The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ADRIANWIT / Simple-SAX-Serializer-0.05 / lib / Simple / SAX / Serializer / Parser.pm 

            

              
1
2
3
4
5
6
7
8
9
10
—
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
—
50
51
52
53
54
55
56
57
58
59
60
61
62
—
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
—
84
85
86
87
88
89
90
91
92
93
94
95
96
—
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
—
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
—
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

              
package Simple::SAX::Serializer::Parser;
use warnings;
use strict;
use vars qw($VERSION);
$VERSION = 0.03;
use base 'XML::SAX::Base';
use Simple::SAX::Serializer::Element;
=head1 NAME
Simple::SAX::Serializer::Parser - Xml parser
=head1 DESCRIPTION
Represents xml parser.
=head1 SYNOPSIS
    use Simple::SAX::Serializer;
    my $xml = Simple::SAX::Serializer->new(file_name => 'dummy.xml')
    $xml->handler('root/child', sub {
    my ($self, $element, $parent) = @_;
    my $attributes = $element->attributes;
    my $result = $parent->children_result;
    $result = $parent->result([])
      unless $result;
    push @$result,Child->new(%$attributes);
    });
=head2 METHODS
=over
=item start_document
Handles the start of the document. Sets up state for the parse.
=cut
sub start_document {
    my ($self) = @_;
    $self->{args} = [];
    $self->{elements} = [];
}
=item start_element
Handles the start of an element.
=cut
sub start_element {
    my ($self, $element) = @_;
    my $elements = $self->{elements};
    push @{$elements}, [$element->{LocalName} =>  attributes($element), undef, ''];
    $self->{elements};
}
=item attributes
=cut
sub attributes {
    my ($element) = @_;
    my %result;
    foreach my $k (keys %{$element->{Attributes}}) {
        my $attr = $element->{Attributes}->{$k};
        my $prefix = $attr->{Prefix};
        if($prefix) {
            $result{"_${prefix}"}{$attr->{LocalName}} ||= {};
            $result{"_${prefix}"}{$attr->{LocalName}} = $attr->{Value};
             
        } else {  
            $result{$attr->{LocalName}} = $attr->{Value};
        }    
    }
    \%result;
}
=item characters
Handles text data in the document.
=cut
sub characters {
    my ($self, $data) = @_;
    my $current_element = $self->{elements}->[-1];
    $current_element->[-1] .= $data->{Data}; 
}
=item end_element
Handles a closing tag.
=cut
my $element = Simple::SAX::Serializer::Element->new;
my $parent = Simple::SAX::Serializer::Element->new;
sub end_element {
    my ($self, $sax_element) = @_;
    my $elements = $self->{elements};
    my $args = $self->{args};
     
    if (my $callback = $self->{parser}->find_handlder($elements)) {
        $element->set_node($elements->[-1]);
        $parent->set_node($elements->[-2]) if (@$elements > 1);
        my $result = $callback->(
          $self,
          $element,
          (@$elements > 1 ? $parent : ())
        );
        $self->{result} = $result if @$elements == 1;
    }
    pop @$args;
    pop @$elements;    
}
=item root_args
Returns parse parameters.
$xml->parse_string($xml_content, {root_param1 => 1, root_param2 => 2;});
=cut
sub root_args {
    my ($self) = @_;
    $self->{root_args} ||= {};
}
1;
__END__
=back
=head1 COPYRIGHT AND LICENSE
The Simple::SAX::Serializer::Parser module is free software. You may distribute under the terms of
either the GNU General Public License or the Artistic License, as specified in
the Perl README file.
=head1 SEE ALSO
L<Simple::SAX::Serializer>
=head1 AUTHOR
Adrian Witas, adrian@webapp.strefa.pl
See also 
=cut