File Coverage

blib/lib/Config/Utils.pm
Criterion Covered Total %
statement 68 68 100.0
branch 22 22 100.0
condition 3 3 100.0
subroutine 8 8 100.0
pod 3 3 100.0
total 104 104 100.0


line stmt bran cond sub pod time code
1             package Config::Utils;
2              
3 5     5   70063 use base qw(Exporter);
  5         29  
  5         560  
4 5     5   28 use strict;
  5         8  
  5         77  
5 5     5   151 use warnings;
  5         18  
  5         163  
6              
7 5     5   1989 use Error::Pure qw(err);
  5         51739  
  5         92  
8 5     5   264 use Readonly;
  5         12  
  5         2357  
9              
10             # Constants.
11             Readonly::Array our @EXPORT_OK => qw(conflict hash hash_array);
12              
13             # Version.
14             our $VERSION = 0.07;
15              
16             # Check conflits.
17             sub conflict {
18 14     14 1 14566 my ($self, $config_hr, $key) = @_;
19 14 100 100     53 if ($self->{'set_conflicts'} && exists $config_hr->{$key}) {
20 4         8 err 'Conflict in \''.join('.', @{$self->{'stack'}}, $key).
  4         26  
21             '\'.';
22             }
23 10         18 return;
24             }
25              
26             # Create record to hash.
27             sub hash {
28 8     8 1 17997 my ($self, $key_ar, $val) = @_;
29 8         13 my $config_hr = $self->{'config'};
30 8         10 my $num = 0;
31 8         12 foreach my $key (@{$key_ar}) {
  8         12  
32 11 100       12 if ($num != $#{$key_ar}) {
  11         23  
33 4 100       14 if (! exists $config_hr->{$key}) {
    100          
34 1         3 $config_hr->{$key} = {};
35             } elsif (ref $config_hr->{$key} ne 'HASH') {
36 2         7 conflict($self, $config_hr, $key);
37 1         2 $config_hr->{$key} = {};
38             }
39 3         13 $config_hr = $config_hr->{$key};
40 3         6 push @{$self->{'stack'}}, $key;
  3         7  
41             } else {
42 7         14 conflict($self, $config_hr, $key);
43              
44             # Process callback.
45 6 100       11 if (defined $self->{'callback'}) {
46             $val = $self->{'callback'}->(
47 1         1 [@{$self->{'stack'}}, $key],
  1         4  
48             $val,
49             );
50             }
51              
52             # Add value.
53 6         12 $config_hr->{$key} = $val;
54              
55             # Clean.
56 6         10 $self->{'stack'} = [];
57             }
58 9         15 $num++;
59             }
60 6         9 return;
61             }
62              
63             # Create record to hash.
64             sub hash_array {
65 10     10 1 17980 my ($self, $key_ar, $val) = @_;
66 10         42 my $config_hr = $self->{'config'};
67 10         11 my $num = 0;
68 10         15 foreach my $key (@{$key_ar}) {
  10         16  
69 13 100       13 if ($num != $#{$key_ar}) {
  13         26  
70 4 100       17 if (! exists $config_hr->{$key}) {
    100          
71 1         3 $config_hr->{$key} = {};
72             } elsif (ref $config_hr->{$key} ne 'HASH') {
73 2         14 conflict($self, $config_hr, $key);
74 1         2 $config_hr->{$key} = {};
75             }
76 3         4 $config_hr = $config_hr->{$key};
77 3         3 push @{$self->{'stack'}}, $key;
  3         7  
78             } else {
79              
80             # Process callback.
81 9 100       18 if (defined $self->{'callback'}) {
82             $val = $self->{'callback'}->(
83 3         4 [@{$self->{'stack'}}, $key],
  3         9  
84             $val,
85             );
86             }
87              
88             # Add value.
89 9 100       27 if (ref $config_hr->{$key} eq 'ARRAY') {
    100          
90 1         2 push @{$config_hr->{$key}}, $val;
  1         4  
91             } elsif ($config_hr->{$key}) {
92 2         3 my $foo = $config_hr->{$key};
93 2         5 $config_hr->{$key} = [$foo, $val];
94             } else {
95 6         10 $config_hr->{$key} = $val;
96             }
97              
98             # Clean.
99 9         12 $self->{'stack'} = [];
100             }
101 12         18 $num++;
102             }
103 9         19 return;
104             }
105              
106             1;
107              
108             __END__