File Coverage

blib/lib/Prancer/Config.pm
Criterion Covered Total %
statement 113 124 91.1
branch 36 54 66.6
condition 12 20 60.0
subroutine 19 20 95.0
pod 4 5 80.0
total 184 223 82.5


line stmt bran cond sub pod time code
1             package Prancer::Config;
2              
3 2     2   852 use strict;
  2         5  
  2         80  
4 2     2   13 use warnings FATAL => 'all';
  2         4  
  2         90  
5              
6 2     2   708 use version;
  2         2002  
  2         15  
7             our $VERSION = '1.05';
8              
9 2     2   238 use File::Spec;
  2         4  
  2         72  
10 2     2   1949 use Config::Any;
  2         24396  
  2         66  
11 2     2   1991 use Storable qw(dclone);
  2         7057  
  2         144  
12 2     2   857 use Try::Tiny;
  2         1514  
  2         107  
13 2     2   12 use Carp;
  2         4  
  2         3026  
14              
15             # even though this *should* work automatically, it was not
16             our @CARP_NOT = qw(Prancer Try::Tiny);
17              
18             sub load {
19 18     18 0 7480 my ($class, $path) = @_;
20 18         46 my $self = bless({}, $class);
21              
22             # find config files, load them
23 18         52 my $files = $self->_build_file_list($path);
24 18         58 $self->{'_config'} = $self->_load_config_files($files);
25              
26 18         78 return $self;
27             }
28              
29             sub has {
30 3     3 1 1204 my ($self, $key) = @_;
31 3         15 return exists($self->{'_config'}->{$key});
32             }
33              
34             sub get {
35 47     47 1 21434 my ($self, $key, $default) = @_;
36              
37             # only return things if the are running in a non-void context
38 47 50       126 if (defined(wantarray())) {
39 47         60 my $value = undef;
40              
41             # if ->get is called without any arguments then this will return all
42             # config values as either a hash or a hashref. used by template engines
43             # to merge config values into the template vars.
44 47 50       103 if (!defined($key)) {
45 0 0       0 return wantarray ? %{$self->{'_config'}} : $self->{'_config'};
  0         0  
46             }
47              
48 47 100       130 if (exists($self->{'_config'}->{$key})) {
49 29         63 $value = $self->{'_config'}->{$key};
50             } else {
51 18         31 $value = $default;
52             }
53              
54             # nothing to return
55 47 100       164 return unless defined($value);
56              
57             # make a clone to avoid changing things
58             # through inadvertent references.
59 32 100       395 $value = dclone($value) if ref($value);
60              
61 32 100 100     108 if (wantarray() && ref($value)) {
62             # return a value rather than a reference
63 3 100       8 if (ref($value) eq "HASH") {
64 1         3 return %{$value};
  1         8  
65             }
66 2 50       6 if (ref($value) eq "ARRAY") {
67 2         3 return @{$value};
  2         10  
68             }
69             }
70              
71             # return a reference
72 29         110 return $value;
73             }
74              
75 0         0 return;
76             }
77              
78             sub set {
79 4     4 1 17 my ($self, $key, $value) = @_;
80              
81 4         6 my $old = undef;
82 4 50       18 $old = $self->get($key) if defined(wantarray());
83              
84 4 50       9 if (ref($value)) {
85             # make a copy of the original value to avoid inadvertently changing
86             # things through inadvertent references
87 0         0 $self->{'_config'}->{$key} = dclone($value);
88             } else {
89             # can't clone non-references
90 4         13 $self->{'_config'}->{$key} = $value;
91             }
92              
93 4 100 66     50 if (wantarray() && ref($old)) {
94             # return a value rather than a reference
95 1 50       5 if (ref($old) eq "HASH") {
96 0         0 return %{$old};
  0         0  
97             }
98 1 50       8 if (ref($old) eq "ARRAY") {
99 1         2 return @{$old};
  1         6  
100             }
101             }
102              
103 3         9 return $old;
104             }
105              
106             sub remove {
107 4     4 1 738 my ($self, $key) = @_;
108              
109 4         7 my $old = undef;
110 4 100       16 $old = $self->get($key) if defined(wantarray());
111              
112 4         13 delete($self->{'_config'}->{$key});
113              
114 4 100 66     19 if (wantarray() && ref($old)) {
115             # return a value rather than a reference
116 1 50       4 if (ref($old) eq "HASH") {
117 0         0 return %{$old};
  0         0  
118             }
119 1 50       5 if (ref($old) eq "ARRAY") {
120 1         1 return @{$old};
  1         7  
121             }
122             }
123              
124 3         6 return $old;
125             }
126              
127             sub _build_file_list {
128 18     18   38 my ($self, $path) = @_;
129              
130             # an undef location means no config files for the caller
131 18 50       55 return [] unless defined($path);
132              
133             # if the path is a file or a link then there is only one config file
134 18 100 66     774 return [ $path ] if (-e $path && (-f $path || -l $path));
      33        
135              
136             # since we already handled files/symlinks then if the path is not a
137             # directory then there is very little we can do
138 9 50       110 return [] unless (-d $path);
139              
140             # figure out what environment we are operating in by looking in several
141             # well known (to the PSGI world) environment variables. if none of them
142             # exist then we are probably in dev.
143 9   50     47 my $env = $ENV{'ENVIRONMENT'} || $ENV{'PLACK_ENV'} || "development";
144              
145 9         20 my @files = ();
146 9         67 for my $ext (Config::Any->extensions()) {
147 90         39977 for my $file (
148             [ $path, "config.${ext}" ],
149             [ $path, "${env}.${ext}" ]
150             ) {
151 180         200 my $file_path = _normalize_file_path(@{$file});
  180         377  
152 180 100       2612 push(@files, $file_path) if (-r $file_path);
153             }
154             }
155              
156 9         31 return \@files;
157             }
158              
159             sub _load_config_files {
160 18     18   42 my ($self, $files) = @_;
161              
162             return _merge(
163 18         25 map { $self->_load_config_file($_) } @{$files}
  18         43  
  18         43  
164             );
165             }
166              
167             sub _load_config_file {
168 18     18   31 my ($self, $file) = @_;
169 18         27 my $config = {};
170              
171             try {
172 18     18   622 my @files = ($file);
173 18         138 my $tmp = Config::Any->load_files({
174             'files' => \@files,
175             'use_ext' => 1,
176             })->[0];
177 18 50       187449 ($file, $config) = %{$tmp} if defined($tmp);
  18         109  
178             } catch {
179 0 0   0   0 my $error = (defined($_) ? $_ : "unknown");
180 0         0 croak "unable to parse ${file}: ${error}";
181 18         135 };
182              
183 18         377 return $config;
184             }
185              
186             sub _normalize_file_path {
187 180     180   1407 my $path = File::Spec->catfile(@_);
188              
189             # this is a revised version of what is described in
190             # http://www.linuxjournal.com/content/normalizing-path-names-bash
191             # by Mitch Frazier
192 180         545 my $seqregex = qr{
193             [^/]* # anything without a slash
194             /\.\.(/|\z) # that is accompanied by two dots as such
195             }x;
196              
197 180         311 $path =~ s{/\./}{/}gx;
198 180         440 $path =~ s{$seqregex}{}gx;
199 180         385 $path =~ s{$seqregex}{}x;
200              
201             # see https://rt.cpan.org/Public/Bug/Display.html?id=80077
202 180         243 $path =~ s{^//}{/}x;
203 180         401 return $path;
204             }
205              
206             # stolen from Hash::Merge::Simple
207             sub _merge {
208 18     18   47 my ($left, @right) = @_;
209              
210 18 100       87 return $left unless @right;
211 3 50       12 return _merge($left, _merge(@right)) if @right > 1;
212              
213 3         8 my ($right) = @right;
214 3         4 my %merged = %{$left};
  3         24  
215              
216 3         7 for my $key (keys %{$right}) {
  3         11  
217 3         7 my ($hr, $hl) = map { ref($_->{$key}) eq "HASH" } $right, $left;
  6         22  
218              
219 3 50 33     14 if ($hr and $hl) {
220 0         0 $merged{$key} = _merge($left->{$key}, $right->{$key});
221             } else {
222 3         12 $merged{$key} = $right->{$key};
223             }
224             }
225              
226 3         13 return \%merged;
227             }
228              
229             1;
230              
231             =head1 NAME
232              
233             Prancer::Config
234              
235             =head1 SYNOPSIS
236              
237             # load a configuration file when creating a PSGI application
238             # this loads only one configuration file
239             my $psgi = Foo->new("/path/to/foobar.yml")->to_psgi_app();
240              
241             # just load the configuration and use it wherever
242             # this loads all configuration files from the given path using logic
243             # described below to figure out which configuration files take precedence
244             my $app = Prancer::Core->new("/path/to/mysite/conf");
245              
246             # the configuration can be accessed as either a global method or as an
247             # instance method, depending on how you loaded Prancer
248             print $app->config->get('foo');
249             print config->get('bar');
250              
251             =head1 DESCRIPTION
252              
253             Prancer uses L to process configuration files. Anything supported
254             by that will be supported by this. It will load configuration files from the
255             configuration file or from configuration files in a path based on what you set
256             when you create your application.
257              
258             To find configuration files from given directory, Prancer::Config follows this
259             logic. First, it will look for a file named C where C is
260             something like C or C. Then it will look for a file named after the
261             currently defined environment like C or C. The
262             environment is determined by looking first for an environment variable called
263             C and then for an environment variable called C. If
264             neither of those exist then the default is C.
265              
266             Configuration files will be merged such that configuration values pulled out of
267             the environment configuration file will take precedence over values from the
268             global configuration file. For example, if you have two configuration files:
269              
270             config.ini
271             ==========
272             foo = bar
273             baz = bat
274              
275             development.ini
276             ===============
277             foo = bazbat
278              
279             After loading these configuration files the value for C will be C
280             and the value for C will be C.
281              
282             If you just have one configuration file and have no desire to load multiple
283             configuration files based on environments you can specify a file rather than a
284             directory when your application is created.
285              
286             Arbitrary configuration directives can be put into your configuration files
287             and they can be accessed like this:
288              
289             $config->get('foo');
290              
291             The configuration accessors will only give you the configuration directives
292             found at the root of the configuration file. So if you use any data structures
293             you will have to decode them yourself. For example, if you create a YAML file
294             like this:
295              
296             foo:
297             bar1: asdf
298             bar2: fdsa
299              
300             Then you will only be able to get the value to C like this:
301              
302             my $foo = config->get('foo')->{'bar1'};
303              
304             =head2 Reserved Configuration Options
305              
306             To support the components of Prancer, some keys are otherwise "reserved" in
307             that you aren't able to use them. For example, trying to use the config key
308             C will only result in sessions being enabled and you not able to see
309             your configuration values. These reserved keys are: C and C.
310              
311             =head1 METHODS
312              
313             =over
314              
315             =item has I
316              
317             This will return true if the named key exists in the configuration:
318              
319             if ($config->has('foo')) {
320             print "I see you've set foo already.\n";
321             }
322              
323             It will return false otherwise.
324              
325             =item get I [I]
326              
327             The get method takes two arguments: a key and a default value. If the key does
328             not exist then the default value will be returned instead. If the value in the
329             configuration is a reference then a clone of the value will be returned to
330             avoid modifying the configuration in a strange way. Additionally, this method
331             is context sensitive.
332              
333             my $foo = $config->get('foo');
334             my %bar = $config->get('bar');
335             my @baz = $config->get('baz');
336              
337             =item set I I
338              
339             The set method takes two arguments: a key and a value. If the key already
340             exists in the configuration then it will be overwritten and the old value will
341             be returned in a context sensitive way. If the value is a reference then it
342             will be cloned before being saved into the configuration to avoid any
343             strangeness.
344              
345             my $old_foo = $config->set('foo', 'bar');
346             my %old_bar = $config->set('bar', { 'baz' => 'bat' });
347             my @old_baz = $config->set('baz', [ 'foo', 'bar', 'baz' ]);
348             $config->set('whatever', 'do not care');
349              
350             =item remove I
351              
352             The remove method takes one argument: the key to remove. The value that was
353             removed will be returned in a context sensitive way.
354              
355             =back
356              
357             =head1 SEE ALSO
358              
359             =over
360              
361             =item L
362              
363             =back
364              
365             =cut