File Coverage

blib/lib/ETR/XML/SAX/FilterHandler.pm
Criterion Covered Total %
statement 9 53 16.9
branch 0 20 0.0
condition n/a
subroutine 3 11 27.2
pod 1 8 12.5
total 13 92 14.1


line stmt bran cond sub pod time code
1             package ETR::XML::SAX::FilterHandler;
2              
3 1     1   23939 use 5.006;
  1         4  
  1         57  
4 1     1   8 use strict;
  1         2  
  1         49  
5 1     1   6 use warnings;
  1         8  
  1         905  
6              
7             =head1 NAME
8              
9             ETR::XML::SAX::FilterHandler - A handler to filter large XML files or streams
10              
11             =head1 VERSION
12              
13             Version 0.01
14              
15             =cut
16              
17             our $VERSION = '0.01';
18              
19              
20             =head1 SYNOPSIS
21              
22             use ETR::XML::SAX::FilterHandler;
23              
24             use XML::SAX::ParserFactory;
25              
26             my $hnd = ETR::XML::SAX::FilterHandler->new({
27              
28             root => books,
29             record => {
30             entry => 1,
31             other_entry => 1
32             },
33             find_data => {
34             "Title 1" => 1,
35             "Title 3" => 1,
36             Oth => 1
37             }
38             });
39              
40             my $str=<
41              
42            
43              
44            
45             Title 1
46            
47            
48             Other title
49            
50            
51             Title 2
52            
53            
54             Title 3
55            
56            
57             EOS
58              
59              
60             my $factory = XML::SAX::ParserFactory->parser(Handler => $hnd);
61              
62             # XML source:
63              
64             # from string
65              
66             print "\nfrom string:\n======\n";
67              
68             $factory->parse_string($str);
69              
70             # from file
71              
72             print "\nfrom file:\n======\n";
73              
74             $factory->parse_file("books.xml");
75              
76             # from standard input
77              
78             print "\nfrom standard input:\n======\n";
79              
80             $factory->parse_file(*STDIN);
81              
82             Every time you should receive the following result:
83              
84            
85              
86            
87              
88             Title 1
89              
90            
91              
92            
93              
94             Other title
95              
96            
97              
98            
99              
100             Title 3
101              
102            
103              
104            
105              
106              
107             =head1 DESCRIPTION
108              
109             Parse large XML files or streams without being load into memory and print
110             to the standard output only the fragments that match to the filtering rules
111             specified by the two parameters: record and find_data.
112              
113             =head1 METHODS
114              
115             =head2
116             new({
117             root => document_root,
118             record => {
119             entry1 => 1,
120             entry2 => 1,
121             ...
122             entrym => 1
123             }
124             find_data => {
125             str1 => 1,
126             str2 => 1,
127             ...
128             strn => 1
129             }
130             })
131              
132             =head3
133             Parameters:
134              
135             root: a string used to enclose the whole document;
136              
137             record: is a hash with element names considered as being record
138             delimiters;
139              
140             find_data: the record is printed out if at least one string from this hash
141             matches to the xml data.
142              
143             Note: The values from the two hashes have to be set to 1, just to force key to be
144             defined.
145              
146             =cut
147              
148             sub new {
149 0     0 1   my ($type, $arg) = @_;
150             #print Dumper($arg->{tag}{entry});
151             #print "...filter\n";
152 0           return bless {
153             buf => "",
154             open => 0,
155             level => 0,
156             found => 0,
157             isdata => 0,
158             indent => " ",
159             record => $arg->{record},
160             find_data => $arg->{find_data},
161             root => $arg->{root}
162             }, $type;
163             }
164              
165             sub start_document{
166 0     0 0   my $self = shift;
167 0 0         print "<$self->{root}>\n" if defined $self->{root};
168             }
169              
170             sub end_document{
171 0     0 0   my $self = shift;
172             #print "End doc\n";
173 0 0         print "{root}>\n" if defined $self->{root};
174             }
175              
176             sub start_element{
177 0     0 0   my ($self, $el) = @_;
178             #print "Starting el $el->{Name} \n";
179             #print "...record","\n" if defined $self->{record}{$el->{Name}};
180 0 0         if (defined $self->{record}{$el->{Name}}){
    0          
181 0           $self->{buf} = "<$el->{Name}";
182             #print Dumper $el->{Attributes};
183 0           $self->add_attr($el->{Attributes});
184 0           $self->{open} = 1;
185 0           $self->{level} = 0;
186 0           $self->{found} = 0;
187 0           $self->{isdata} = 0;
188             }
189             elsif($self->{open}){
190 0           $self->{level}++;
191             #chomp($el->{Name});
192             #print $el->{Name},"\n";
193             #print $self->{level},"\n";
194 0           $self->indent;
195 0           $self->{buf} .= "<$el->{Name}" ;
196 0           $self->add_attr($el->{Attributes});
197             }
198             }
199              
200             sub end_element{
201 0     0 0   my ($self, $el) = @_;
202             #print "Ending element $el->{Name}\n";
203 0 0         if (defined $self->{record}{$el->{Name}}){
    0          
204 0           $self->{buf} .= "{Name}>\n";
205 0           $self->{open} = 0;
206             #$self->{buf} =~ s/^\s*\n//mg;
207 0 0         print $self->{buf} if $self->{found};
208             }
209             elsif ($self->{open}){
210 0 0         if($self->{isdata}){
211 0           $self->{isdata} = 0;
212             }
213             else{
214 0           $self->{level}--;
215 0           $self->indent;
216             }
217 0           $self->{level}--;
218 0           $self->{buf} .= "{Name}>\n";
219             }
220             }
221              
222             sub characters{
223 0     0 0   my($self, $char) = @_;
224 0           chomp($char->{Data});
225 0 0         if($char->{Data} ne ""){
226 0           chomp($self->{buf});
227 0           $self->{isdata} = 1;
228             }
229              
230 0           $self->{buf} .= $char->{Data};
231 0           my $find = $self->{find_data};
232 0           foreach(keys (%$find)){
233             #print "key=$_","\n";
234 0 0         $self->{found} = 1 if $char->{Data} =~ $_;
235             }
236             }
237              
238             sub indent{
239 0     0 0   my $self = shift;
240 0           $self->{buf} .= ($self->{indent} x $self->{level});
241             }
242             sub add_attr{
243 0     0 0   my ($self, $attr) = @_;
244             #print Dumper($attr);
245 0           foreach (keys( %$attr)){
246 0           $self->{buf} .= " $attr->{$_}{Name}=\"$attr->{$_}{Value}\"";
247             }
248 0           $self->{buf} .= ">\n";
249             }
250              
251              
252              
253              
254             =head1 AUTHOR
255              
256             Daniel Necsoiu, Ericsson, C<< >>
257              
258             =head1 BUGS
259              
260             Please report any bugs or feature requests to C, or through
261             the web interface at L. I will be notified, and then you'll
262             automatically be notified of progress on your bug as I make changes.
263              
264              
265              
266              
267             =head1 SUPPORT
268              
269             You can find documentation for this module with the perldoc command.
270              
271             perldoc ETR::XML::SAX::FilterHandler
272              
273              
274             You can also look for information at:
275              
276             =over 4
277              
278             =item * RT: CPAN's request tracker (report bugs here)
279              
280             L
281              
282             =item * AnnoCPAN: Annotated CPAN documentation
283              
284             L
285              
286             =item * CPAN Ratings
287              
288             L
289              
290             =item * Search CPAN
291              
292             L
293              
294             =back
295              
296              
297             =head1 ACKNOWLEDGEMENTS
298              
299              
300             =head1 LICENSE AND COPYRIGHT
301              
302             Copyright 2015 Daniel Necsoiu, Ericsson.
303              
304             This program is free software; you can redistribute it and/or modify it
305             under the terms of either: the GNU General Public License as published
306             by the Free Software Foundation; or the Artistic License.
307              
308             See L for more information.
309              
310              
311             =cut
312              
313             1; # End of ETR::XML::SAX::FilterHandler