File Coverage

lib/Config/Neat/Array.pm
Criterion Covered Total %
statement 40 56 71.4
branch 9 18 50.0
condition 2 9 22.2
subroutine 9 10 90.0
pod 0 7 0.0
total 60 100 60.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Config::Neat::Array - Class for array-like config nodes
4              
5             =head1 COPYRIGHT
6              
7             Copyright (C) 2012-2015 Igor Afanasyev
8              
9             =head1 SEE ALSO
10              
11             L
12              
13             =cut
14              
15             package Config::Neat::Array;
16              
17             our $VERSION = '1.401';
18              
19 4     4   25 use strict;
  4         7  
  4         123  
20              
21 4     4   19 no warnings qw(uninitialized);
  4         8  
  4         153  
22              
23 4     4   876 use Config::Neat::Util qw(is_any_array is_neat_array);
  4         7  
  4         2954  
24              
25             sub new {
26 789     789 0 1583 my ($class, $self) = @_;
27 789 100 66     1968 $self = [] unless defined $self && ref($self) eq 'ARRAY';
28 789         1231 bless $self, $class;
29 789         2245 return $self;
30             }
31              
32             sub push {
33 18     18 0 123 my $self = shift;
34 18         49 push @$self, @_;
35             }
36              
37             # return a flattened one-dimensional array, where nested
38             # Config::Neat arrays are expanded recursively
39             sub as_flat_array {
40 215     215 0 374 my ($self) = @_;
41              
42             # fist check if conversion will be needed
43 215         286 my $need_conversion;
44 215         365 foreach my $val (@$self) {
45 283 100       525 if (is_neat_array($val)) {
46 10         15 $need_conversion = 1;
47 10         18 last;
48             }
49             }
50 215 100       610 return $self unless $need_conversion;
51              
52             # flatten the array recursively
53 10         24 my $result = Config::Neat::Array->new();
54 10         22 foreach my $val (@$self) {
55 28 50       55 if (is_neat_array($val)) {
56 28         51 $val = $val->as_flat_array;
57             }
58              
59 28 50       54 if (is_any_array($val)) {
60             # expand arrays
61 28         78 push @$result, @$val;
62             } else {
63             #push scalars and hashes as is
64 0         0 push @$result, $val;
65             }
66             }
67 10         32 return $result;
68             }
69              
70             # Given ['foo', 'bar', 'baz'] as the contents of the array, returns 'foo bar baz' string.
71             # Array is flattened before being converted into a string.
72             # If string starts from a newline and the next line is indented, remove that amount of spaces
73             # from each line and trim leading and trailing newline
74             sub as_string {
75 159     159 0 4867 my ($self) = @_;
76              
77 159         223 my $val = join(' ', @{$self->as_flat_array});
  159         289  
78 159         256 my $indent = undef;
79 159         452 while ($val =~ m/\n(\s+)/g) {
80 0         0 my $len = length($1);
81 0 0 0     0 $indent = $len unless defined $indent and $len > 0;
82 0 0 0     0 $indent = $len if $len > 0 and $indent > $len;
83             }
84 159 50       388 if ($indent > 0) {
85 0         0 $indent = ' ' x $indent;
86 0         0 $val =~ s/\n$indent/\n/sg;
87 0         0 $val =~ s/^\s*\n//s; # remove first single newline and preceeding whitespace
88 0         0 $val =~ s/\n\s*$//s; # remove last single newline and whitespace after it
89             }
90 159         646 return $val;
91             } # end sub
92              
93             # Returns true if the string representation of the array
94             # evaluates case-insensitively to a known list of positive boolean strings
95             sub as_boolean {
96 21     21 0 96 my ($self) = @_;
97              
98 21         52 return ($self->as_string =~ m/^(YES|Y|ON|TRUE|1)$/i);
99             } # end sub
100              
101             # Returns true if the string representation of the array
102             # evaluates case-insensitively to a known list of positive or negative boolean strings
103             sub is_boolean {
104 11     11 0 18 my ($self) = @_;
105              
106 11         22 return ($self->as_string =~ m/^(YES|NO|Y|N|ON|OFF|TRUE|FALSE|1|0)$/i);
107             } # end sub
108              
109             # Given ['foo', 'bar', 'baz'] as the contents of the array,
110             # and property name 'x', returns the following hash reference:
111             # {
112             # 0 => {'x' => 'foo'},
113             # 1 => {'x' => 'bar'},
114             # 2 => {'x' => 'baz'}
115             # }
116             sub as_hash {
117 0     0 0   my ($self, $propname) = @_;
118              
119 0 0         die "Second parameter (propname) not provided" unless defined $propname;
120              
121 0           my $result = {};
122 0           tie(%$result, 'Tie::IxHash');
123              
124 0           my $n = 0;
125 0           foreach my $val (@$self) {
126 0           $result->{$n++} = {$propname => $val};
127             }
128              
129 0           return $result;
130             } # end sub
131              
132             1;