File Coverage

blib/lib/Prancer/Config.pm
Criterion Covered Total %
statement 21 77 27.3
branch 0 16 0.0
condition 0 5 0.0
subroutine 7 19 36.8
pod 0 6 0.0
total 28 123 22.8


line stmt bran cond sub pod time code
1             package Prancer::Config;
2              
3 4     4   9 use strict;
  4         4  
  4         112  
4 4     4   20 use warnings FATAL => 'all';
  4         4  
  4         99  
5              
6 4     4   8 use File::Spec;
  4         3  
  4         100  
7 4     4   808 use Config::Any;
  4         21465  
  4         94  
8 4     4   814 use Hash::Merge::Simple;
  4         1381  
  4         171  
9 4     4   15 use Storable qw(dclone);
  4         4  
  4         141  
10 4     4   13 use Try::Tiny;
  4         3  
  4         3211  
11              
12             sub load {
13 0     0 0       my ($class, $location) = @_;
14 0               my $self = bless({}, $class);
15              
16             # find config files, load them
17 0               my @files = $self->_build_file_list($location);
18 0               $self->{'_config'} = $self->_load_config_files(@files);
19              
20 0               return $self;
21             }
22              
23             sub has {
24 0     0 0       my ($self, $key) = @_;
25 0               return exists($self->{'_config'}->{$key});
26             }
27              
28             sub get {
29 0     0 0       my ($self, $key) = @_;
30              
31             # only return things if the are running in a non-void context
32 0 0 0           if (defined(wantarray()) && defined($self->{'_config'}->{$key})) {
33             # make a clone of the value to avoid inadvertently changing things
34             # via references
35 0                   my $value = $self->{'_config'}->{$key};
36 0 0                 return dclone($value) if ref($value);
37 0                   return $value;
38                 }
39              
40 0               return;
41             }
42              
43             sub set {
44 0     0 0       my ($self, $key, $value) = @_;
45              
46 0               my $old = undef;
47 0 0             $old = $self->get($key) if defined(wantarray());
48              
49 0 0             if (ref($value)) {
50             # make a copy of the original value to avoid inadvertently changing
51             # things via references
52 0                   $self->{'_config'}->{$key} = dclone($value);
53                 } else {
54             # can't clone non-references
55 0                   $self->{'_config'}->{$key} = $value;
56                 }
57 0               return $old;
58             }
59              
60             sub remove {
61 0     0 0       my ($self, $key) = @_;
62 0               return delete($self->{'_config'}->{$key});
63             }
64              
65             sub _build_file_list {
66 0     0         my ($self, $location) = @_;
67              
68             # an undef location means no config files for the caller
69 0 0             return [] unless defined($location);
70              
71 0   0           my $running_env = $ENV{ENVIRONMENT} || $ENV{PLACK_ENV} || 'development';
72 0               my @exts = Config::Any->extensions();
73 0               my @files = ();
74              
75 0               foreach my $ext (@exts) {
76 0                   foreach my $file (
77                         [ $location, "config.${ext}" ],
78                         [ $location, "${running_env}.${ext}" ]
79                     ) {
80 0                       my $path = _normalize_path(@{$file});
  0            
81 0 0                     next unless (-r $path);
82              
83 0                       push(@files, $path);
84                     }
85                 }
86              
87 0               return @files;
88             }
89              
90             sub as_hashref {
91 0     0 0       my $self = shift;
92 0               return $self->{'_config'};
93             }
94              
95             sub _load_config_files {
96 0     0         my ($self, @files) = @_;
97              
98 0               return Hash::Merge::Simple->merge(
99 0                   map { $self->_load_config_file($_) } @files
100                 );
101             }
102              
103             sub _load_config_file {
104 0     0         my ($self, $file) = @_;
105 0               my $config = {};
106              
107                 try {
108 0     0             my @files = ($file);
109 0                   my $tmp = Config::Any->load_files({
110                         'files' => \@files,
111                         'use_ext' => 1,
112                     })->[0];
113 0 0                 ($file, $config) = %{$tmp} if defined($tmp);
  0            
114                 } catch {
115 0 0   0             my $error = (defined($_) ? $_ : "unknown");
116 0                   die "unable to parse configuration file: ${file}: ${error}\n";
117 0               };
118              
119 0               return $config;
120             }
121              
122             sub _normalize_path {
123 0     0         my $path = File::Spec->catfile(@_);
124              
125             # this is a revised version of what is described in
126             # http://www.linuxjournal.com/content/normalizing-path-names-bash
127             # by Mitch Frazier
128 0               my $seqregex = qr{
129             [^/]* # anything without a slash
130             /\.\.(/|\z) # that is accompanied by two dots as such
131             }x;
132              
133 0               $path =~ s{/\./}{/}gx;
134 0               $path =~ s{$seqregex}{}gx;
135 0               $path =~ s{$seqregex}{}x;
136              
137             # see https://rt.cpan.org/Public/Bug/Display.html?id=80077
138 0               $path =~ s{^//}{/}x;
139 0               return $path;
140             }
141              
142             1;
143              
144             =head1 NAME
145            
146             Prancer::Config
147            
148             =head1 SYNOPSIS
149            
150             This module should not be used directly to access the logger. Instead, one
151             should use L<Prancer>.
152            
153             =cut
154