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   57887 use base qw(Exporter);
  5         22  
  5         523  
4 5     5   25 use strict;
  5         7  
  5         89  
5 5     5   24 use warnings;
  5         16  
  5         239  
6              
7 5     5   1771 use Error::Pure qw(err);
  5         45954  
  5         88  
8 5     5   243 use Readonly;
  5         9  
  5         2240  
9              
10             # Constants.
11             Readonly::Array our @EXPORT_OK => qw(conflict hash hash_array);
12              
13             # Version.
14             our $VERSION = 0.08;
15              
16             # Check conflits.
17             sub conflict {
18 14     14 1 13731 my ($self, $config_hr, $key) = @_;
19 14 100 100     61 if ($self->{'set_conflicts'} && exists $config_hr->{$key}) {
20 4         7 err 'Conflict in \''.join('.', @{$self->{'stack'}}, $key).
  4         30  
21             '\'.';
22             }
23 10         15 return;
24             }
25              
26             # Create record to hash.
27             sub hash {
28 8     8 1 17891 my ($self, $key_ar, $val) = @_;
29 8         12 my $config_hr = $self->{'config'};
30 8         9 my $num = 0;
31 8         8 foreach my $key (@{$key_ar}) {
  8         11  
32 11 100       11 if ($num != $#{$key_ar}) {
  11         19  
33 4 100       13 if (! exists $config_hr->{$key}) {
    100          
34 1         2 $config_hr->{$key} = {};
35             } elsif (ref $config_hr->{$key} ne 'HASH') {
36 2         6 conflict($self, $config_hr, $key);
37 1         2 $config_hr->{$key} = {};
38             }
39 3         19 $config_hr = $config_hr->{$key};
40 3         7 push @{$self->{'stack'}}, $key;
  3         6  
41             } else {
42 7         13 conflict($self, $config_hr, $key);
43              
44             # Process callback.
45 6 100       10 if (defined $self->{'callback'}) {
46             $val = $self->{'callback'}->(
47 1         2 [@{$self->{'stack'}}, $key],
  1         5  
48             $val,
49             );
50             }
51              
52             # Add value.
53 6         11 $config_hr->{$key} = $val;
54              
55             # Clean.
56 6         8 $self->{'stack'} = [];
57             }
58 9         14 $num++;
59             }
60 6         9 return;
61             }
62              
63             # Create record to hash.
64             sub hash_array {
65 10     10 1 20364 my ($self, $key_ar, $val) = @_;
66 10         16 my $config_hr = $self->{'config'};
67 10         11 my $num = 0;
68 10         8 foreach my $key (@{$key_ar}) {
  10         18  
69 13 100       13 if ($num != $#{$key_ar}) {
  13         20  
70 4 100       13 if (! exists $config_hr->{$key}) {
    100          
71 1         3 $config_hr->{$key} = {};
72             } elsif (ref $config_hr->{$key} ne 'HASH') {
73 2         12 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         5  
78             } else {
79              
80             # Process callback.
81 9 100       20 if (defined $self->{'callback'}) {
82             $val = $self->{'callback'}->(
83 3         4 [@{$self->{'stack'}}, $key],
  3         7  
84             $val,
85             );
86             }
87              
88             # Add value.
89 9 100       23 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         4 my $foo = $config_hr->{$key};
93 2         4 $config_hr->{$key} = [$foo, $val];
94             } else {
95 6         97 $config_hr->{$key} = $val;
96             }
97              
98             # Clean.
99 9         14 $self->{'stack'} = [];
100             }
101 12         18 $num++;
102             }
103 9         16 return;
104             }
105              
106             1;
107              
108             __END__