File Coverage

blib/lib/CCCP/ConfigXML.pm
Criterion Covered Total %
statement 37 40 92.5
branch 6 14 42.8
condition 2 6 33.3
subroutine 10 11 90.9
pod 0 3 0.0
total 55 74 74.3


line stmt bran cond sub pod time code
1             package CCCP::ConfigXML;
2              
3 1     1   1649 use strict;
  1         2  
  1         41  
4 1     1   5 use warnings;
  1         2  
  1         33  
5              
6 1     1   847 use namespace::autoclean;
  1         45262  
  1         5  
7 1     1   1865 use XML::Bare;
  1         21349  
  1         96  
8 1     1   2487 use Hash::Merge::Simple qw(merge);
  1         1187  
  1         790  
9              
10             our $VERSION = '0.02';
11              
12             my $singletone = undef;
13             $CCCP::ConfigXML::like_singletone = 0;
14              
15             sub import {
16 1     1   13 my ($class, %param) = @_;
17 1 50 33     17 $CCCP::ConfigXML::like_singletone = 1 if ($param{as} and $param{as} eq 'singletone');
18 1         15 return;
19             }
20              
21             sub new {
22 1     1 0 988 my ($class, %param) = @_;
23            
24             # support singletone if needed
25 1 50 33     10 return $singletone if ($CCCP::ConfigXML::like_singletone and $singletone);
26            
27 1         4 my $self = bless {}, $class;
28            
29 1         4 my ($file,$text) = map {delete $param{$_}} qw(file text);
  2         8  
30 1 50       5 if ($file) {
31 0         0 $self->add_file($_, %param) for _to_array($file);
32             };
33 1 50       4 if ($text) {
34 1         4 $self->add_text($_, %param) for _to_array($text);
35             };
36 1 50       15 $singletone = $self if $CCCP::ConfigXML::like_singletone;
37 1         4 return $self;
38             }
39              
40 1 0   1   9 sub _to_array { return grep {$_} map {UNIVERSAL::isa($_,'ARRAY') ? @$_ : (ref $_ ? undef : $_)} @_ }
  2 50       8  
  1         8  
41              
42             sub add_file {
43 0     0 0 0 my ($self, $file, @arg) = @_;
44 0         0 return $self->_add_hash(XML::Bare->new(file => $file, @arg)->parse());
45             }
46              
47             sub add_text {
48 3     3 0 2101 my ($self, $xml_str, @arg) = @_;
49 3         19 return $self->_add_hash(XML::Bare->new(text => $xml_str, @arg)->parse());
50             }
51              
52             # job method, but not present. may be later.
53             sub _add_hash {
54 3     3   276 my ($self, $hash) = @_;
55 3         6 %$self = %{merge $self, $hash};
  3         8  
56 3         342 return 1;
57             }
58              
59             1;
60             __END__