Commit | Line | Data |
f004a98a |
1 | package Catalyst::Plugin::ConfigLoader; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Config::Any; |
7 | use NEXT; |
8 | use Data::Visitor::Callback; |
7f0397f8 |
9 | use Catalyst::Utils (); |
f004a98a |
10 | |
4f63af80 |
11 | our $VERSION = '0.19'; |
f004a98a |
12 | |
13 | =head1 NAME |
14 | |
15 | Catalyst::Plugin::ConfigLoader - Load config files of various types |
16 | |
17 | =head1 SYNOPSIS |
18 | |
19 | package MyApp; |
20 | |
21 | # ConfigLoader should be first in your list so |
22 | # other plugins can get the config information |
23 | use Catalyst qw( ConfigLoader ... ); |
24 | |
25 | # by default myapp.* will be loaded |
26 | # you can specify a file if you'd like |
3231a8d0 |
27 | __PACKAGE__->config( 'Plugin::ConfigLoader' => { file => 'config.yaml' } ); |
f004a98a |
28 | |
29 | =head1 DESCRIPTION |
30 | |
31 | This module will attempt to load find and load a configuration |
32 | file of various types. Currently it supports YAML, JSON, XML, |
3231a8d0 |
33 | INI and Perl formats. Special configuration for a particular driver format can |
34 | be stored in C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ driver }>. |
f004a98a |
35 | |
36 | To support the distinction between development and production environments, |
37 | this module will also attemp to load a local config (e.g. myapp_local.yaml) |
38 | which will override any duplicate settings. |
39 | |
40 | =head1 METHODS |
41 | |
42 | =head2 setup( ) |
43 | |
44 | This method is automatically called by Catalyst's setup routine. It will |
45 | attempt to use each plugin and, once a file has been successfully |
46 | loaded, set the C<config()> section. |
47 | |
48 | =cut |
49 | |
50 | sub setup { |
51 | my $c = shift; |
52 | my @files = $c->find_files; |
587d381b |
53 | my $cfg = Config::Any->load_files( |
54 | { files => \@files, |
55 | filter => \&_fix_syntax, |
56 | use_ext => 1, |
57 | driver_args => $c->config->{ 'Plugin::ConfigLoader' }->{ driver } |
58 | || {}, |
59 | } |
60 | ); |
f004a98a |
61 | |
62 | # split the responses into normal and local cfg |
63 | my $local_suffix = $c->get_config_local_suffix; |
587d381b |
64 | my ( @cfg, @localcfg ); |
65 | for ( @$cfg ) { |
66 | if ( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) { |
f004a98a |
67 | push @localcfg, $_; |
587d381b |
68 | } |
69 | else { |
f004a98a |
70 | push @cfg, $_; |
71 | } |
72 | } |
587d381b |
73 | |
f004a98a |
74 | # load all the normal cfgs, then the local cfgs last so they can override |
75 | # normal cfgs |
76 | $c->load_config( $_ ) for @cfg, @localcfg; |
77 | |
78 | $c->finalize_config; |
79 | $c->NEXT::setup( @_ ); |
80 | } |
81 | |
82 | =head2 load_config |
83 | |
84 | This method handles loading the configuration data into the Catalyst |
85 | context object. It does not return a value. |
86 | |
87 | =cut |
88 | |
89 | sub load_config { |
90 | my $c = shift; |
91 | my $ref = shift; |
587d381b |
92 | |
e538c6f7 |
93 | my ( $file, $config ) = %$ref; |
587d381b |
94 | |
f004a98a |
95 | $c->config( $config ); |
96 | $c->log->debug( qq(Loaded Config "$file") ) |
97 | if $c->debug; |
98 | |
99 | return; |
100 | } |
101 | |
102 | =head2 find_files |
103 | |
104 | This method determines the potential file paths to be used for config loading. |
105 | It returns an array of paths (up to the filename less the extension) to pass to |
106 | L<Config::Any|Config::Any> for loading. |
107 | |
108 | =cut |
109 | |
110 | sub find_files { |
111 | my $c = shift; |
587d381b |
112 | my ( $path, $extension ) = $c->get_config_path; |
f004a98a |
113 | my $suffix = $c->get_config_local_suffix; |
114 | my @extensions = @{ Config::Any->extensions }; |
587d381b |
115 | |
f004a98a |
116 | my @files; |
587d381b |
117 | if ( $extension ) { |
f004a98a |
118 | next unless grep { $_ eq $extension } @extensions; |
4f63af80 |
119 | ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension}; |
120 | push @files, $path, $local; |
587d381b |
121 | } |
122 | else { |
f004a98a |
123 | @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions; |
124 | } |
125 | |
126 | @files; |
127 | } |
128 | |
129 | =head2 get_config_path |
130 | |
131 | This method determines the path, filename prefix and file extension to be used |
132 | for config loading. It returns the path (up to the filename less the |
133 | extension) to check and the specific extension to use (if it was specified). |
134 | |
135 | The order of preference is specified as: |
136 | |
137 | =over 4 |
138 | |
139 | =item * C<$ENV{ MYAPP_CONFIG }> |
140 | |
7f0397f8 |
141 | =item * C<$ENV{ CATALYST_CONFIG }> |
142 | |
eb05f0bf |
143 | =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ file }> |
f004a98a |
144 | |
145 | =item * C<$c-E<gt>path_to( $application_prefix )> |
146 | |
147 | =back |
148 | |
149 | If either of the first two user-specified options are directories, the |
150 | application prefix will be added on to the end of the path. |
151 | |
af391898 |
152 | DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated |
153 | and will be removed in the next release. |
154 | |
f004a98a |
155 | =cut |
156 | |
157 | sub get_config_path { |
587d381b |
158 | my $c = shift; |
afce197f |
159 | |
160 | # deprecation notice |
587d381b |
161 | if ( exists $c->config->{ file } ) { |
162 | $c->log->warn( |
77d8f18e |
163 | q(*** "file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }") |
164 | sleep( 3 ); |
587d381b |
165 | ); |
afce197f |
166 | } |
167 | |
f004a98a |
168 | my $appname = ref $c || $c; |
169 | my $prefix = Catalyst::Utils::appprefix( $appname ); |
7f0397f8 |
170 | my $path = Catalyst::Utils::env_value( $c, 'CONFIG' ) |
af391898 |
171 | || $c->config->{ 'Plugin::ConfigLoader' }->{ file } |
587d381b |
172 | || $c->config->{ file } # to be removed next release |
f004a98a |
173 | || $c->path_to( $prefix ); |
174 | |
587d381b |
175 | my ( $extension ) = ( $path =~ m{\.(.{1,4})$} ); |
176 | |
177 | if ( -d $path ) { |
178 | $path =~ s{[\/\\]$}{}; |
f004a98a |
179 | $path .= "/$prefix"; |
180 | } |
4f63af80 |
181 | |
587d381b |
182 | return ( $path, $extension ); |
f004a98a |
183 | } |
184 | |
185 | =head2 get_config_local_suffix |
186 | |
187 | Determines the suffix of files used to override the main config. By default |
188 | this value is C<local>, but it can be specified in the following order of preference: |
189 | |
190 | =over 4 |
191 | |
f004a98a |
192 | =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> |
193 | |
7f0397f8 |
194 | =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }> |
195 | |
af391898 |
196 | =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }> |
f004a98a |
197 | |
198 | =back |
199 | |
af391898 |
200 | DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ config_local_suffix }> is deprecated |
201 | and will be removed in the next release. |
202 | |
f004a98a |
203 | =cut |
204 | |
205 | sub get_config_local_suffix { |
587d381b |
206 | my $c = shift; |
afce197f |
207 | |
208 | # deprecation notice |
587d381b |
209 | if ( exists $c->config->{ config_local_suffix } ) { |
210 | $c->log->warn( |
77d8f18e |
211 | q("*** config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }") |
212 | sleep( 3 ); |
587d381b |
213 | ); |
afce197f |
214 | } |
215 | |
f004a98a |
216 | my $appname = ref $c || $c; |
587d381b |
217 | my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' ) |
af391898 |
218 | || $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix } |
587d381b |
219 | || $c->config |
220 | ->{ config_local_suffix } # to be remove in the next release |
f004a98a |
221 | || 'local'; |
222 | |
223 | return $suffix; |
224 | } |
225 | |
226 | sub _fix_syntax { |
227 | my $config = shift; |
228 | my @components = ( |
229 | map +{ |
230 | prefix => $_ eq 'Component' ? '' : $_ . '::', |
231 | values => delete $config->{ lc $_ } || delete $config->{ $_ } |
232 | }, |
587d381b |
233 | grep { ref $config->{ lc $_ } || ref $config->{ $_ } } |
234 | qw( Component Model M View V Controller C ) |
f004a98a |
235 | ); |
236 | |
237 | foreach my $comp ( @components ) { |
238 | my $prefix = $comp->{ prefix }; |
239 | foreach my $element ( keys %{ $comp->{ values } } ) { |
240 | $config->{ "$prefix$element" } = $comp->{ values }->{ $element }; |
241 | } |
242 | } |
243 | } |
244 | |
245 | =head2 finalize_config |
246 | |
247 | This method is called after the config file is loaded. It can be |
248 | used to implement tuning of config values that can only be done |
249 | at runtime. If you need to do this to properly configure any |
250 | plugins, it's important to load ConfigLoader before them. |
251 | ConfigLoader provides a default finalize_config method which |
d392c48d |
252 | walks through the loaded config hash and calls the C<config_substitutions> |
253 | sub on any string. |
f004a98a |
254 | |
255 | =cut |
256 | |
257 | sub finalize_config { |
258 | my $c = shift; |
259 | my $v = Data::Visitor::Callback->new( |
260 | plain_value => sub { |
261 | return unless defined $_; |
d392c48d |
262 | $c->config_substitutions( $_ ); |
f004a98a |
263 | } |
264 | ); |
265 | $v->visit( $c->config ); |
266 | } |
267 | |
d392c48d |
268 | =head2 config_substitutions( $value ) |
269 | |
270 | This method substitutes macros found with calls to a function. There are three |
271 | default macros: |
272 | |
273 | =over 4 |
274 | |
275 | =item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')> |
276 | |
277 | =item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')> |
278 | |
279 | =item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use |
280 | C<__DATA__> as a config value, for example) |
281 | |
282 | =back |
283 | |
284 | The parameter list is split on comma (C<,>). You can override this method to |
285 | do your own string munging, or you can define your own macros in |
af391898 |
286 | C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>. |
287 | Example: |
d392c48d |
288 | |
af391898 |
289 | MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = { |
d392c48d |
290 | baz => sub { my $c = shift; qux( @_ ); } |
291 | } |
292 | |
293 | The above will respond to C<__baz(x,y)__> in config strings. |
294 | |
295 | =cut |
296 | |
297 | sub config_substitutions { |
587d381b |
298 | my $c = shift; |
299 | my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions } |
300 | || {}; |
301 | $subs->{ HOME } ||= sub { shift->path_to( '' ); }; |
d392c48d |
302 | $subs->{ path_to } ||= sub { shift->path_to( @_ ); }; |
303 | $subs->{ literal } ||= sub { return $_[ 1 ]; }; |
304 | my $subsre = join( '|', keys %$subs ); |
305 | |
306 | for ( @_ ) { |
307 | s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $c, $2 ? split( /,/, $2 ) : () ) }eg; |
308 | } |
309 | } |
310 | |
f004a98a |
311 | =head1 AUTHOR |
312 | |
01be879a |
313 | Brian Cassidy E<lt>bricas@cpan.orgE<gt> |
f004a98a |
314 | |
315 | =head1 CONTRIBUTORS |
316 | |
317 | The following people have generously donated their time to the |
318 | development of this module: |
319 | |
320 | =over 4 |
321 | |
322 | =item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any> |
323 | |
324 | =item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration |
325 | |
326 | =back |
327 | |
328 | Work to this module has been generously sponsored by: |
329 | |
330 | =over 4 |
331 | |
332 | =item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein |
333 | |
334 | =back |
335 | |
336 | =head1 COPYRIGHT AND LICENSE |
337 | |
80ffa192 |
338 | Copyright 2007 by Brian Cassidy |
f004a98a |
339 | |
340 | This library is free software; you can redistribute it and/or modify |
341 | it under the same terms as Perl itself. |
342 | |
343 | =head1 SEE ALSO |
344 | |
345 | =over 4 |
346 | |
347 | =item * L<Catalyst> |
348 | |
affbca23 |
349 | =item * L<Catalyst::Plugin::ConfigLoader::Manual> |
350 | |
f004a98a |
351 | =item * L<Config::Any> |
352 | |
353 | =back |
354 | |
355 | =cut |
356 | |
357 | 1; |