lib/Catalyst/Plugin/ConfigLoader.pm

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