File Coverage

blib/lib/Config/FromHash.pm
Criterion Covered Total %
statement 65 77 84.4
branch 16 32 50.0
condition 5 13 38.4
subroutine 10 12 83.3
pod 0 6 0.0
total 96 140 68.5


line stmt bran cond sub pod time code
1 1     1   26427 use strict;
  1         1  
  1         35  
2 1     1   4 use warnings;
  1         1  
  1         23  
3 1     1   10 use 5.10.1;
  1         3  
  1         61  
4              
5             package Config::FromHash;
6              
7             our $VERSION = '0.0702'; # VERSION
8             # ABSTRACT: Read config files containing hashes
9              
10 1     1   4 use File::Basename();
  1         2  
  1         13  
11 1     1   443 use Hash::Merge();
  1         2000  
  1         21  
12 1     1   669 use Path::Tiny;
  1         10601  
  1         533  
13              
14              
15             sub new {
16 2     2 0 416 my($class, %args) = @_;
17              
18 2   50     7 $args{'data'} ||= {};
19 2   33     15 $args{'sep'} ||= qr!/!;
20 2   50     8 $args{'require_all_files'} ||= 0;
21              
22 2 50 33     8 if(exists $args{'filename'} && exists $args{'filenames'}) {
23 0         0 die "Don't use both 'filename' and 'filenames'.";
24             }
25 2 50 33     13 if(exists $args{'environment'} && exists $args{'environments'}) {
26 0         0 die "Don't use both 'environment' and 'environments'.";
27             }
28              
29 2 50       5 $args{'filenames'} = $args{'filename'} if exists $args{'filename'};
30              
31              
32 2 100       4 if(exists $args{'filenames'}) {
33 1 50       5 if(ref $args{'filenames'} ne 'ARRAY') {
34 0         0 $args{'filenames'} = [ $args{'filenames'} ];
35             }
36             }
37             else {
38 1         3 $args{'filenames'} = [];
39             }
40              
41 2 50       3 $args{'environments'} = $args{'filename'} if exists $args{'filename'};
42              
43 2 50       5 if(exists $args{'environments'}) {
44 0 0       0 if(ref $args{'environments'} ne 'ARRAY') {
45 0         0 $args{'environments'} = [ $args{'environments'} ];
46             }
47             }
48             else {
49 2         4 $args{'environments'} = [ undef ];
50             }
51              
52 2         4 my $self = bless \%args => $class;
53              
54 2         8 Hash::Merge::set_behavior('LEFT_PRECEDENT');
55 2         34 my $data = $args{'data'};
56              
57 2 100       2 if(scalar @{ $args{'filenames'} }) {
  2         7  
58              
59 1         2 foreach my $environment (reverse @{ $args{'environments'} }) {
  1         3  
60              
61 1         3 FILE:
62 1         2 foreach my $config_file (reverse @{ $args{'filenames'} }) {
63 1         93 my($filename, $directory, $extension) = File::Basename::fileparse($config_file, qr{\.[^.]+$});
64 1 50       7 my $new_filename = $directory . $filename . (defined $environment ? ".$environment" : '') . $extension;
65              
66 1 50       42 if(!-e $new_filename) {
67 0 0       0 die "$new_filename does not exist" if $self->require_all_files;
68 0         0 next FILE;
69             }
70              
71 1         4 $data = Hash::Merge::merge($self->parse($config_file, $data));
72              
73             }
74             }
75             }
76 2         2533 $args{'data'} = $data;
77              
78 2         6 return $self;
79              
80             }
81              
82             sub data {
83 0     0 0 0 return shift->{'data'};
84             }
85              
86             sub get {
87 5     5 0 600 my $self = shift;
88 5         6 my $path = shift;
89              
90 5 50       12 if(!defined $path) {
91 0         0 warn "No path defined - nothing to return";
92 0         0 return;
93             }
94              
95 5         25 my @parts = split $self->{'sep'} => $path;
96 5         9 my $hash = $self->{'data'};
97              
98 5         7 foreach my $part (@parts) {
99 8 50       15 if(ref $hash eq 'HASH') {
100 8         14 $hash = $hash->{ $part };
101             }
102             else {
103 0         0 die "Can't resolve path '$path' beyond '$part'";
104             }
105             }
106 5         22 return $hash;
107             }
108              
109             sub parse {
110 1     1 0 2 my $self = shift;
111 1         1 my $file = shift;
112              
113 1         6 my $contents = path($file)->slurp_utf8;
114 1         1276 my($parsed, $error) = $self->eval($contents);
115              
116 1 50       5 die "Can't parse <$file>: $error" if $error;
117 1 50       4 die "<$file> doesn't contain hash" if ref $parsed ne 'HASH';
118              
119 1         4 return $parsed;
120              
121             }
122              
123             sub eval {
124 1     1 0 2 my $self = shift;
125 1         1 my $contents = shift;
126              
127 1         55 return (eval $contents, $@);
128             }
129              
130             sub require_all_files {
131 0     0 0   return shift->{'require_all_files'};
132             }
133              
134              
135             1;
136              
137             __END__