File Coverage

blib/lib/Catalyst/Plugin/ConfigLoader.pm
Criterion Covered Total %
statement 70 76 92.1
branch 8 16 50.0
condition 8 23 34.8
subroutine 13 13 100.0
pod 6 6 100.0
total 105 134 78.4


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::ConfigLoader;
2              
3 4     4   63 use strict;
  4         59  
  4         92  
4 4     4   64 use warnings;
  4         36  
  4         64  
5              
6 4     4   168 use Config::Any;
  4         48  
  4         99  
7 4     4   121 use NEXT;
  4         37  
  4         76  
8 4     4   156 use Data::Visitor::Callback;
  4         50  
  4         100  
9              
10             our $VERSION = '0.13';
11              
12             =head1 NAME
13            
14             Catalyst::Plugin::ConfigLoader - Load config files of various types
15            
16             =head1 SYNOPSIS
17            
18             package MyApp;
19            
20             # ConfigLoader should be first in your list so
21             # other plugins can get the config information
22             use Catalyst qw( ConfigLoader ... );
23            
24             # by default myapp.* will be loaded
25             # you can specify a file if you'd like
26             __PACKAGE__->config( file => 'config.yaml' );
27            
28             =head1 DESCRIPTION
29            
30             This module will attempt to load find and load a configuration
31             file of various types. Currently it supports YAML, JSON, XML,
32             INI and Perl formats.
33            
34             To support the distinction between development and production environments,
35             this module will also attemp to load a local config (e.g. myapp_local.yaml)
36             which will override any duplicate settings.
37            
38             =head1 METHODS
39            
40             =head2 setup( )
41            
42             This method is automatically called by Catalyst's setup routine. It will
43             attempt to use each plugin and, once a file has been successfully
44             loaded, set the C<config()> section.
45            
46             =cut
47              
48             sub setup {
49 2     2 1 22     my $c = shift;
50 2         37     my @files = $c->find_files;
51 2         68     my $cfg = Config::Any->load_files( {
52                     files => \@files,
53                     filter => \&_fix_syntax,
54                     use_ext => 1
55                 } );
56              
57             # split the responses into normal and local cfg
58 2         64     my $local_suffix = $c->get_config_local_suffix;
59 2         21     my( @cfg, @localcfg );
60 2         25     for( @$cfg ) {
61 3 100       84         if( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) {
62 1         12             push @localcfg, $_;
63                     } else {
64 2         24             push @cfg, $_;
65                     }
66                 }
67                 
68             # load all the normal cfgs, then the local cfgs last so they can override
69             # normal cfgs
70 2         19     $c->load_config( $_ ) for @cfg, @localcfg;
  2         73  
71              
72 2         39     $c->finalize_config;
73 2         65     $c->NEXT::setup( @_ );
74             }
75              
76             =head2 load_config
77            
78             This method handles loading the configuration data into the Catalyst
79             context object. It does not return a value.
80            
81             =cut
82              
83             sub load_config {
84 3     3 1 31     my $c = shift;
85 3         27     my $ref = shift;
86                 
87 3         215     my( $file, $config ) = each %$ref;
88                 
89 3         52     $c->config( $config );
90 3 50       49     $c->log->debug( qq(Loaded Config "$file") )
91                     if $c->debug;
92              
93 3         69     return;
94             }
95              
96             =head2 find_files
97            
98             This method determines the potential file paths to be used for config loading.
99             It returns an array of paths (up to the filename less the extension) to pass to
100             L<Config::Any|Config::Any> for loading.
101            
102             =cut
103              
104             sub find_files {
105 2     2 1 20     my $c = shift;
106 2         34     my( $path, $extension ) = $c->get_config_path;
107 2         47     my $suffix = $c->get_config_local_suffix;
108 2         19     my @extensions = @{ Config::Any->extensions };
  2         36  
109                 
110 2         24     my @files;
111 2 50       23     if ($extension) {
112 0 0       0         next unless grep { $_ eq $extension } @extensions;
  0         0  
113 0         0         push @files, $path, "${path}_${suffix}";
114                 } else {
115 2         20         @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
  20         207  
116                 }
117              
118 2         853     @files;
119             }
120              
121             =head2 get_config_path
122            
123             This method determines the path, filename prefix and file extension to be used
124             for config loading. It returns the path (up to the filename less the
125             extension) to check and the specific extension to use (if it was specified).
126            
127             The order of preference is specified as:
128            
129             =over 4
130            
131             =item * C<$ENV{ MYAPP_CONFIG }>
132            
133             =item * C<$c-E<gt>config-E<gt>{ file }>
134            
135             =item * C<$c-E<gt>path_to( $application_prefix )>
136            
137             =back
138            
139             If either of the first two user-specified options are directories, the
140             application prefix will be added on to the end of the path.
141            
142             =cut
143              
144             sub get_config_path {
145 2     2 1 19     my $c = shift;
146 2   33     32     my $appname = ref $c || $c;
147 2         26     my $prefix = Catalyst::Utils::appprefix( $appname );
148                 my $path = $ENV{ Catalyst::Utils::class2env( $appname ) . '_CONFIG' }
149                     || $c->config->{ file }
150 2   33     27         || $c->path_to( $prefix );
      33        
151              
152 2         25     my( $extension ) = ( $path =~ m{\.(.{1,4})$} );
153                 
154 2 50       20     if( -d $path ) {
155 0         0         $path =~ s{[\/\\]$}{};
156 0         0         $path .= "/$prefix";
157                 }
158                 
159 2         119     return( $path, $extension );
160             }
161              
162             =head2 get_config_local_suffix
163            
164             Determines the suffix of files used to override the main config. By default
165             this value is C<local>, but it can be specified in the following order of preference:
166            
167             =over 4
168            
169             =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
170            
171             =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
172            
173             =item * C<$c-E<gt>config-E<gt>{ config_local_suffix }>
174            
175             =back
176            
177             =cut
178              
179             sub get_config_local_suffix {
180 4     4 1 41     my $c = shift;
181 4   33     58     my $appname = ref $c || $c;
182                 my $suffix = $ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }
183                     || $ENV{ Catalyst::Utils::class2env( $appname ) . '_CONFIG_LOCAL_SUFFIX' }
184                     || $c->config->{ config_local_suffix }
185 4   33     127         || 'local';
      33        
      50        
186              
187 4         48     return $suffix;
188             }
189              
190             sub _fix_syntax {
191 3     3   164     my $config = shift;
192 21 50       331     my @components = (
193                     map +{
194                         prefix => $_ eq 'Component' ? '' : $_ . '::',
195                         values => delete $config->{ lc $_ } || delete $config->{ $_ }
196                     },
197                     grep {
198 3 50 33     43             ref $config->{ lc $_ } || ref $config->{ $_ }
199                     }
200                     qw( Component Model M View V Controller C )
201                 );
202              
203 3         41     foreach my $comp ( @components ) {
204 1         13         my $prefix = $comp->{ prefix };
205 1         9         foreach my $element ( keys %{ $comp->{ values } } ) {
  1         13  
206 1         22             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
207                     }
208                 }
209             }
210              
211             =head2 finalize_config
212            
213             This method is called after the config file is loaded. It can be
214             used to implement tuning of config values that can only be done
215             at runtime. If you need to do this to properly configure any
216             plugins, it's important to load ConfigLoader before them.
217             ConfigLoader provides a default finalize_config method which
218             walks through the loaded config hash and replaces any strings
219             beginning containing C<__HOME__> with the full path to
220             app's home directory (i.e. C<$c-E<gt>path_to('')> ).
221             You can also use C<__path_to(foo/bar)__> which translates to
222             C<$c-E<gt>path_to('foo', 'bar')>
223            
224             =cut
225              
226             sub finalize_config {
227 2     2 1 22     my $c = shift;
228                 my $v = Data::Visitor::Callback->new(
229                     plain_value => sub {
230 12 50   12   117             return unless defined $_;
231 12         116             s{__HOME__}{ $c->path_to( '' ) }e;
  1         22  
232 12         148             s{__path_to\((.+)\)__}{ $c->path_to( split( '/', $1 ) ) }e;
  0         0  
233                     }
234 2         59     );
235 2         35     $v->visit( $c->config );
236             }
237              
238             =head1 AUTHOR
239            
240             =over 4
241            
242             =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
243            
244             =back
245            
246             =head1 CONTRIBUTORS
247            
248             The following people have generously donated their time to the
249             development of this module:
250            
251             =over 4
252            
253             =item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any>
254            
255             =item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration
256            
257             =back
258            
259             Work to this module has been generously sponsored by:
260            
261             =over 4
262            
263             =item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein
264            
265             =back
266            
267             =head1 COPYRIGHT AND LICENSE
268            
269             Copyright 2006 by Brian Cassidy
270            
271             This library is free software; you can redistribute it and/or modify
272             it under the same terms as Perl itself.
273            
274             =head1 SEE ALSO
275            
276             =over 4
277            
278             =item * L<Catalyst>
279            
280             =item * L<Config::Any>
281            
282             =back
283            
284             =cut
285              
286             1;
287