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; |
9 | |
3af1b75e |
10 | our $VERSION = '0.15'; |
f004a98a |
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 | my $c = shift; |
50 | my @files = $c->find_files; |
51 | 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 | my $local_suffix = $c->get_config_local_suffix; |
59 | my( @cfg, @localcfg ); |
60 | for( @$cfg ) { |
61 | if( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) { |
62 | push @localcfg, $_; |
63 | } else { |
64 | push @cfg, $_; |
65 | } |
66 | } |
67 | |
68 | # load all the normal cfgs, then the local cfgs last so they can override |
69 | # normal cfgs |
70 | $c->load_config( $_ ) for @cfg, @localcfg; |
71 | |
72 | $c->finalize_config; |
73 | $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 | my $c = shift; |
85 | my $ref = shift; |
86 | |
87 | my( $file, $config ) = each %$ref; |
88 | |
89 | $c->config( $config ); |
90 | $c->log->debug( qq(Loaded Config "$file") ) |
91 | if $c->debug; |
92 | |
93 | 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 | my $c = shift; |
106 | my( $path, $extension ) = $c->get_config_path; |
107 | my $suffix = $c->get_config_local_suffix; |
108 | my @extensions = @{ Config::Any->extensions }; |
109 | |
110 | my @files; |
111 | if ($extension) { |
112 | next unless grep { $_ eq $extension } @extensions; |
113 | push @files, $path, "${path}_${suffix}"; |
114 | } else { |
115 | @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions; |
116 | } |
117 | |
118 | @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 | my $c = shift; |
146 | my $appname = ref $c || $c; |
147 | my $prefix = Catalyst::Utils::appprefix( $appname ); |
148 | my $path = $ENV{ Catalyst::Utils::class2env( $appname ) . '_CONFIG' } |
149 | || $c->config->{ file } |
150 | || $c->path_to( $prefix ); |
151 | |
152 | my( $extension ) = ( $path =~ m{\.(.{1,4})$} ); |
153 | |
154 | if( -d $path ) { |
155 | $path =~ s{[\/\\]$}{}; |
156 | $path .= "/$prefix"; |
157 | } |
158 | |
159 | 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 | my $c = shift; |
181 | 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 | || 'local'; |
186 | |
187 | return $suffix; |
188 | } |
189 | |
190 | sub _fix_syntax { |
191 | my $config = shift; |
192 | my @components = ( |
193 | map +{ |
194 | prefix => $_ eq 'Component' ? '' : $_ . '::', |
195 | values => delete $config->{ lc $_ } || delete $config->{ $_ } |
196 | }, |
197 | grep { |
198 | ref $config->{ lc $_ } || ref $config->{ $_ } |
199 | } |
200 | qw( Component Model M View V Controller C ) |
201 | ); |
202 | |
203 | foreach my $comp ( @components ) { |
204 | my $prefix = $comp->{ prefix }; |
205 | foreach my $element ( keys %{ $comp->{ values } } ) { |
206 | $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 | my $c = shift; |
228 | my $v = Data::Visitor::Callback->new( |
229 | plain_value => sub { |
230 | return unless defined $_; |
3af1b75e |
231 | s{__HOME__}{ $c->path_to( '' ) }eg; |
232 | s{__path_to\((.+?)\)__}{ $c->path_to( split( '/', $1 ) ) }eg; |
f004a98a |
233 | } |
234 | ); |
235 | $v->visit( $c->config ); |
236 | } |
237 | |
238 | =head1 AUTHOR |
239 | |
01be879a |
240 | Brian Cassidy E<lt>bricas@cpan.orgE<gt> |
f004a98a |
241 | |
242 | =head1 CONTRIBUTORS |
243 | |
244 | The following people have generously donated their time to the |
245 | development of this module: |
246 | |
247 | =over 4 |
248 | |
249 | =item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any> |
250 | |
251 | =item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration |
252 | |
253 | =back |
254 | |
255 | Work to this module has been generously sponsored by: |
256 | |
257 | =over 4 |
258 | |
259 | =item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein |
260 | |
261 | =back |
262 | |
263 | =head1 COPYRIGHT AND LICENSE |
264 | |
80ffa192 |
265 | Copyright 2007 by Brian Cassidy |
f004a98a |
266 | |
267 | This library is free software; you can redistribute it and/or modify |
268 | it under the same terms as Perl itself. |
269 | |
270 | =head1 SEE ALSO |
271 | |
272 | =over 4 |
273 | |
274 | =item * L<Catalyst> |
275 | |
affbca23 |
276 | =item * L<Catalyst::Plugin::ConfigLoader::Manual> |
277 | |
f004a98a |
278 | =item * L<Config::Any> |
279 | |
280 | =back |
281 | |
282 | =cut |
283 | |
284 | 1; |