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