line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Mowyw::Datasource::XML; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
2578
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
46
|
|
4
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
43
|
|
5
|
2
|
|
|
2
|
|
6
|
use base 'App::Mowyw::Datasource::Array'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
714
|
|
6
|
2
|
|
|
2
|
|
6
|
use XML::Simple; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
17
|
|
7
|
2
|
|
|
2
|
|
96
|
use Scalar::Util qw(reftype); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
57
|
|
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
6
|
use Carp qw(confess); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
420
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new { |
12
|
5
|
|
|
5
|
0
|
17
|
my ($class, $opts) = @_; |
13
|
5
|
|
|
|
|
17
|
my $self = bless { OPTIONS => $opts, INDEX => 0 }, $class; |
14
|
|
|
|
|
|
|
|
15
|
5
|
50
|
|
|
|
15
|
my $file = $opts->{file} or confess "Mandatory option 'file' is missing\n"; |
16
|
5
|
|
|
|
|
9
|
$opts->{source} = $self->_read_data($file); |
17
|
|
|
|
|
|
|
# print Dumper $opts; |
18
|
4
|
|
|
|
|
35
|
$self = $self->SUPER::new($opts); |
19
|
|
|
|
|
|
|
|
20
|
4
|
|
|
|
|
58
|
return $self; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub _read_data { |
24
|
5
|
|
|
5
|
|
5
|
my ($self, $file) = @_; |
25
|
5
|
|
|
|
|
4
|
my $data; |
26
|
5
|
100
|
|
|
|
17
|
if (exists $self->{OPTIONS}{root}){ |
27
|
2
|
|
|
|
|
8
|
$data = XML::Simple->new->parse_file($file, ForceArray => [ $self->{OPTIONS}{root} ]); |
28
|
|
|
|
|
|
|
} else { |
29
|
3
|
|
|
|
|
15
|
$data = XML::Simple->new->parse_file($file); |
30
|
|
|
|
|
|
|
} |
31
|
5
|
50
|
|
|
|
111068
|
if (reftype $data eq 'ARRAY'){ |
32
|
0
|
|
|
|
|
0
|
return $data; |
33
|
|
|
|
|
|
|
} else { |
34
|
5
|
100
|
|
|
|
14
|
if (exists $self->{OPTIONS}{root}){ |
35
|
2
|
|
|
|
|
9
|
return $data->{$self->{OPTIONS}{root}}; |
36
|
|
|
|
|
|
|
} else { |
37
|
3
|
|
|
|
|
8
|
my @keys = keys %$data; |
38
|
3
|
100
|
|
|
|
9
|
if (@keys > 1){ |
|
|
50
|
|
|
|
|
|
39
|
1
|
|
|
|
|
172
|
confess "More than one root item, and no 'root' option specified"; |
40
|
|
|
|
|
|
|
} elsif (@keys == 0){ |
41
|
0
|
|
|
|
|
0
|
return []; |
42
|
|
|
|
|
|
|
} else { |
43
|
2
|
|
|
|
|
10
|
return $data->{$keys[0]}; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
1; |