File Coverage

blib/lib/App/RecordStream/Operation/fromxml.pm
Criterion Covered Total %
statement 25 25 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 34 100.0


line stmt bran cond sub pod time code
1             package App::RecordStream::Operation::fromxml;
2              
3             our $VERSION = "4.0.23";
4              
5 2     2   562 use strict;
  2         5  
  2         47  
6 2     2   10 use warnings;
  2         4  
  2         45  
7              
8 2     2   7 use base qw(App::RecordStream::Operation);
  2         4  
  2         110  
9              
10 2     2   10 use App::RecordStream::Record;
  2         10  
  2         40  
11              
12 2     2   9 use App::RecordStream::OptionalRequire 'HTTP::Request';
  2         4  
  2         12  
13 2     2   10 use App::RecordStream::OptionalRequire 'LWP::UserAgent';
  2         4  
  2         9  
14 2     2   11 use App::RecordStream::OptionalRequire 'List::MoreUtils', qw(uniq);
  2         4  
  2         9  
15 2     2   10 use App::RecordStream::OptionalRequire 'XML::Twig';
  2         4  
  2         8  
16 2     2   9 BEGIN { App::RecordStream::OptionalRequire::require_done() }
17              
18             sub init {
19             my $this = shift;
20             my $args = shift;
21              
22             my @elements;
23             my $nested = 0;
24              
25             my $spec = {
26             'element=s' => sub { push @elements, split(/,/, $_[1]) },
27             'nested' => \$nested,
28             };
29              
30             $this->parse_options($args, $spec);
31              
32             $this->{'ELEMENTS'} = [ uniq @elements ];
33             $this->{'NESTED'} = $nested;
34              
35             my $has_files = scalar @$args;
36             $this->{'HAS_URIS'} = $has_files;
37              
38             $this->{'EXTRA_ARGS'} = $args;
39             $this->{'OPEN_TAGS'} = 0;
40             }
41              
42             sub wants_input {
43             return 0;
44             }
45              
46             sub stream_done {
47             my $this = shift;
48              
49             my $elements = $this->{'ELEMENTS'};
50              
51             my $elem_prefix = '/*/';
52             my $attr_prefix = '/';
53              
54             if ( $this->{'NESTED'} ) {
55             $elem_prefix .= '/';
56             $attr_prefix .= '/';
57             }
58              
59             my %start_tag_handlers;
60             my %twig_roots;
61              
62             for my $element ( @$elements ) {
63             my $elem_expr = $elem_prefix . $element;
64             my $attr_expr = $attr_prefix . '[@' . $element . ']';
65             my $default_hash = {};
66              
67             if ( @$elements > 1 ) {
68             $default_hash->{'element'} = $element;
69             }
70              
71             $start_tag_handlers{$elem_expr} = sub { $this->{'OPEN_TAGS'}++ };
72             $twig_roots{$elem_expr} = sub { $this->handle_element($default_hash, @_) };
73             $twig_roots{$attr_expr} = sub { $this->handle_attribute($element, $default_hash, @_) };
74             }
75              
76             my $twig = XML::Twig->new(
77             start_tag_handlers => \%start_tag_handlers,
78             twig_roots => \%twig_roots);
79              
80             while ( my $xml = $this->get_xml_string() ) {
81             $twig->parse($xml);
82             }
83             }
84              
85             sub handle_element {
86             my ($this, $default_hash, $twig, $elem) = @_;
87              
88             $this->{'OPEN_TAGS'}--; # force evaluation of outer elements before inner
89              
90             if ( $this->{'OPEN_TAGS'} == 0 ) {
91             my $s = $elem->simplify('forcearray' => 1,
92             'keyattr' => [] );
93              
94             $this->push_value($s, $default_hash);
95             $twig->purge;
96             }
97              
98             return 0; # don't trigger attr handler
99             }
100              
101             sub handle_attribute {
102             my ($this, $name, $default_hash, $twig, $elem) = @_;
103              
104             if ( $this->{'OPEN_TAGS'} == 0 ) {
105             $this->push_value($elem->att($name), $default_hash);
106             }
107             }
108              
109             sub push_value {
110             my $this = shift;
111             my $value = shift;
112             my $default_hash = shift;
113              
114             if ( UNIVERSAL::isa($value, 'HASH') ) {
115             my $record = App::RecordStream::Record->new($value);
116             foreach my $key ( keys %$default_hash ) {
117             $record->{$key} = $default_hash->{$key};
118             }
119              
120             $this->push_record($record);
121             }
122             elsif ( UNIVERSAL::isa($value, 'ARRAY') ) {
123             foreach my $item (@$value) {
124             $this->push_value($item, $default_hash);
125             }
126             }
127             else {
128             my $record = App::RecordStream::Record->new(%$default_hash);
129             $record->{'value'} = $value;
130             $this->push_record($record);
131             }
132             }
133              
134             sub get_xml_string {
135             my $this = shift;
136              
137             my $uris = $this->{'EXTRA_ARGS'};
138              
139             my $contents;
140             if ( $this->{'HAS_URIS'} ) {
141             return undef unless ( @$uris );
142              
143             my $uri = shift @$uris;
144             $this->update_current_filename($uri);
145              
146             my $ua = $this->make_user_agent();
147             my $response = $ua->request($this->get_request($uri));
148              
149             if ( ! $response->is_success() ) {
150             warn "GET uri: '$uri' failed, skipping!\n";
151             return $this->get_xml_string();
152             }
153              
154             $contents = $response->content();
155             }
156             else {
157             local $/;
158             $contents = ;
159             }
160              
161             return $contents;
162             }
163              
164             sub get_request {
165             my $this = shift;
166             my $uri = shift;
167              
168             my $request = HTTP::Request->new();
169             $request->method('GET');
170             $request->uri($uri);
171              
172             return $request;
173             }
174              
175             sub make_user_agent {
176             return LWP::UserAgent->new();
177             }
178              
179             sub usage {
180             my $this = shift;
181              
182             my $options = [
183             [ 'element ', 'May be comma separated, may be specified multiple times. Sets the elements/attributes to print records for'],
184             [ 'nested', 'search for elements at all levels of the xml document'],
185             ];
186              
187             my $args_string = $this->options_string($options);
188              
189             return <
190             Usage: recs-fromxml []
191             __FORMAT_TEXT__
192             Reads either from STDIN or from the specified URIs. Parses the xml
193             documents, and creates records for the specified elements.
194             If multiple element types are specified, will add a {'element' => element name} field to the output record.
195             __FORMAT_TEXT__
196              
197             $args_string
198              
199             Examples:
200             Create records for the bar element at the top level of myXMLDoc
201             recs-fromxml --element bar file:myXMLDoc
202             Create records for all foo and bar elements from the URL
203             recs-fromxml --element foo,bar --nested http://google.com
204             USAGE
205             }
206              
207             1;