File Coverage

blib/lib/Config/Dot/Array.pm
Criterion Covered Total %
statement 92 92 100.0
branch 26 26 100.0
condition 9 9 100.0
subroutine 14 14 100.0
pod 4 4 100.0
total 145 145 100.0


line stmt bran cond sub pod time code
1             package Config::Dot::Array;
2              
3             # Pragmas.
4 7     7   24891 use strict;
  7         9  
  7         211  
5 7     7   27 use warnings;
  7         8  
  7         172  
6              
7             # Modules.
8 7     7   3155 use Class::Utils qw(set_params);
  7         82212  
  7         125  
9 7     7   3582 use Config::Utils qw(hash_array);
  7         4742  
  7         123  
10 7     7   365 use English qw(-no_match_vars);
  7         10  
  7         34  
11 7     7   2480 use Error::Pure qw(err);
  7         8  
  7         267  
12 7     7   29 use Readonly;
  7         8  
  7         8673  
13              
14             # Constants.
15             Readonly::Scalar my $EMPTY_STR => q{};
16              
17             # Version.
18             our $VERSION = 0.04;
19              
20             # Constructor.
21             sub new {
22 15     15 1 7570 my ($class, @params) = @_;
23 15         41 my $self = bless {}, $class;
24              
25             # Callback.
26 15         46 $self->{'callback'} = undef;
27              
28             # Config hash.
29 15         22 $self->{'config'} = {};
30              
31             # Set conflicts detection as error.
32 15         19 $self->{'set_conflicts'} = 1;
33              
34             # Process params.
35 15         45 set_params($self, @params);
36              
37             # Check config hash.
38 13 100       127 if (! $self->_check($self->{'config'})) {
39 3         9 err 'Bad \'config\' parameter.';
40             }
41              
42             # Check callback.
43 10 100 100     42 if (defined $self->{'callback'} && ref $self->{'callback'} ne 'CODE') {
44 1         3 err 'Parameter \'callback\' isn\'t code reference.';
45             }
46              
47             # Count of lines.
48 9         16 $self->{'count'} = 0;
49              
50             # Stack.
51 9         14 $self->{'stack'} = [];
52              
53             # Object.
54 9         23 return $self;
55             }
56              
57             # Parse text or array of texts.
58             sub parse {
59 5     5 1 25 my ($self, $string_or_array_ref) = @_;
60 5         6 my @text;
61 5 100       10 if (ref $string_or_array_ref eq 'ARRAY') {
62 2         3 @text = @{$string_or_array_ref};
  2         5  
63             } else {
64 3         28 @text = split m/$INPUT_RECORD_SEPARATOR/ms,
65             $string_or_array_ref;
66             }
67 5         8 foreach my $line (@text) {
68 12         14 $self->{'count'}++;
69 12         22 $self->_parse($line);
70             }
71 4         35 return $self->{'config'};
72             }
73              
74             # Reset content.
75             sub reset {
76 4     4 1 3475 my $self = shift;
77 4         8 $self->{'config'} = {};
78 4         9 $self->{'count'} = 0;
79 4         25 return;
80             }
81              
82             # Serialize.
83             sub serialize {
84 5     5 1 30 my $self = shift;
85 5         14 return join "\n", $self->_serialize($self->{'config'});
86             }
87              
88             # Check structure.
89             sub _check {
90 21     21   23 my ($self, $config_ref) = @_;
91 21 100       61 if (ref $config_ref eq 'HASH') {
    100          
92 15         15 foreach my $key (sort keys %{$config_ref}) {
  15         54  
93 10 100 100     42 if (ref $config_ref->{$key} ne ''
94             && ! $self->_check($config_ref->{$key})) {
95              
96 2         5 return 0;
97             }
98             }
99 13         44 return 1;
100             } elsif (ref $config_ref eq 'ARRAY') {
101 3         4 foreach my $val (@{$config_ref}) {
  3         20  
102 5 100 100     16 if (ref $val ne '' && ! $self->_check($val)) {
103 1         3 return 0;
104             }
105             }
106 2         9 return 1;
107             } else {
108 3         12 return 0;
109             }
110             }
111              
112             # Parse string.
113             sub _parse {
114 12     12   9 my ($self, $string) = @_;
115              
116             # Remove comments on single line.
117 12         20 $string =~ s/^\s*#.*$//ms;
118              
119             # Blank space.
120 12 100       41 if ($string =~ m/^\s*$/ms) {
121 2         2 return 0;
122             }
123              
124             # Split.
125 10         19 my ($key, $val) = split m/=/ms, $string, 2;
126              
127             # Not a key.
128 10 100       23 if (length $key < 1) {
129 1         2 return 0;
130             }
131              
132             # Bad key.
133 9 100       26 if ($key !~ m/^[-\w\.:,]+\+?$/ms) {
134 1         9 err "Bad key '$key' in string '$string' at line ".
135             "'$self->{'count'}'.";
136             }
137              
138 8         15 my @tmp = split m/\./ms, $key;
139 8         20 hash_array($self, \@tmp, $val);
140              
141             # Ok.
142 8         137 return 1;
143             }
144              
145             # Serialize.
146             sub _serialize {
147 12     12   13 my ($self, $config_ref) = @_;
148 12 100       23 if (ref $config_ref eq 'HASH') {
    100          
149 6         6 my @ret;
150 6         9 foreach my $key (sort keys %{$config_ref}) {
  6         14  
151 5         19 my @subkey = $self->_serialize(
152             $config_ref->{$key});
153 5         8 foreach my $subkey (@subkey) {
154 6 100       25 if ($subkey !~ m/^=/ms) {
155 1         2 $subkey = '.'.$subkey;
156             }
157 6         16 push @ret, $key.$subkey;
158             }
159             }
160 6         33 return @ret;
161             } elsif (ref $config_ref eq 'ARRAY') {
162 1         2 my @ret;
163 1         1 foreach my $val (@{$config_ref}) {
  1         2  
164 2         3 push @ret, $self->_serialize($val);
165             }
166 1         3 return @ret;
167             } else {
168 5         12 return '='.$config_ref;
169             }
170             }
171              
172             1;
173              
174             __END__