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         die "Unable to handle files with the extension '${extension}'"
 130             unless grep { $_ eq $extension } @extensions;
 131         ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
 132         push @files, $path, $local;
 133     }
 134     else {
 135         @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
 136     }
 137     @files;
 138 }
 139
 140 =head2 get_config_path
 141
 142 This method determines the path, filename prefix and file extension to be used
 143 for config loading. It returns the path (up to the filename less the
 144 extension) to check and the specific extension to use (if it was specified).
 145
 146 The order of preference is specified as:
 147
 148 =over 4
 149
 150 =item * C<$ENV{ MYAPP_CONFIG }>
 151
 152 =item * C<$ENV{ CATALYST_CONFIG }>
 153
 154 =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ file }>
 155
 156 =item * C<$c-E<gt>path_to( $application_prefix )>
 157
 158 =back
 159
 160 If either of the first two user-specified options are directories, the
 161 application prefix will be added on to the end of the path.
 162
 163 DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
 164 and will be removed in the next release.
 165
 166 =cut
 167
 168 sub get_config_path {
 169     my $c = shift;
 170
 171     # deprecation notice
 172     if ( exists $c->config->{ file } ) {
 173         $c->log->warn(
 174             q(*** "file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }")
 175         );
 176         sleep( 3 );
 177     }
 178
 179     my $appname = ref $c || $c;
 180     my $prefix  = Catalyst::Utils::appprefix( $appname );
 181     my $path    = Catalyst::Utils::env_value( $c, 'CONFIG' )
 182         || $c->config->{ 'Plugin::ConfigLoader' }->{ file }
 183         || $c->config->{ file }    # to be removed next release
 184         || $c->path_to( $prefix );
 185
 186     my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 187
 188     if ( -d $path ) {
 189         $path =~ s{[\/\\]$}{};
 190         $path .= "/$prefix";
 191     }
 192
 193     return ( $path, $extension );
 194 }
 195
 196 =head2 get_config_local_suffix
 197
 198 Determines the suffix of files used to override the main config. By default
 199 this value is C<local>, but it can be specified in the following order of preference:
 200
 201 =over 4
 202
 203 =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
 204
 205 =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
 206
 207 =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
 208
 209 =back
 210
 211 DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ config_local_suffix }> is deprecated
 212 and will be removed in the next release.
 213
 214 =cut
 215
 216 sub get_config_local_suffix {
 217     my $c = shift;
 218
 219     # deprecation notice
 220     if ( exists $c->config->{ config_local_suffix } ) {
 221         $c->log->warn(
 222             q(*** "config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }")
 223         );
 224         sleep( 3 );
 225     }
 226
 227     my $appname = ref $c || $c;
 228     my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
 229         || $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
 230         || $c->config
 231         ->{ config_local_suffix }    # to be remove in the next release
 232         || 'local';
 233
 234     return $suffix;
 235 }
 236
 237 sub _fix_syntax {
 238     my $config     = shift;
 239     my @components = (
 240         map +{
 241             prefix => $_ eq 'Component' ? '' : $_ . '::',
 242             values => delete $config->{ lc $_ } || delete $config->{ $_ }
 243         },
 244         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 245             qw( Component Model M View V Controller C )
 246     );
 247
 248     foreach my $comp ( @components ) {
 249         my $prefix = $comp->{ prefix };
 250         foreach my $element ( keys %{ $comp->{ values } } ) {
 251             $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
 252         }
 253     }
 254 }
 255
 256 =head2 finalize_config
 257
 258 This method is called after the config file is loaded. It can be
 259 used to implement tuning of config values that can only be done
 260 at runtime. If you need to do this to properly configure any
 261 plugins, it's important to load ConfigLoader before them.
 262 ConfigLoader provides a default finalize_config method which
 263 walks through the loaded config hash and calls the C<config_substitutions>
 264 sub on any string.
 265
 266 =cut
 267
 268 sub finalize_config {
 269     my $c = shift;
 270     my $v = Data::Visitor::Callback->new(
 271         plain_value => sub {
 272             return unless defined $_;
 273             $c->config_substitutions( $_ );
 274         }
 275     );
 276     $v->visit( $c->config );
 277 }
 278
 279 =head2 config_substitutions( $value )
 280
 281 This method substitutes macros found with calls to a function. There are three
 282 default macros:
 283
 284 =over 4
 285
 286 =item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
 287
 288 =item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
 289
 290 =item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
 291 C<__DATA__> as a config value, for example)
 292
 293 =back
 294
 295 The parameter list is split on comma (C<,>). You can override this method to
 296 do your own string munging, or you can define your own macros in
 297 C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
 298 Example:
 299
 300     MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
 301         baz => sub { my $c = shift; qux( @_ ); }
 302     }
 303
 304 The above will respond to C<__baz(x,y)__> in config strings.
 305
 306 =cut
 307
 308 sub config_substitutions {
 309     my $c    = shift;
 310     my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions }
 311         || {};
 312     $subs->{ HOME }    ||= sub { shift->path_to( '' ); };
 313     $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
 314     $subs->{ literal } ||= sub { return $_[ 1 ]; };
 315     my $subsre = join( '|', keys %$subs );
 316
 317     for ( @_ ) {
 318         s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $c, $2 ? split( /,/, $2 ) : () ) }eg;
 319     }
 320 }
 321
 322 =head1 AUTHOR
 323
 324 Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 325
 326 =head1 CONTRIBUTORS
 327
 328 The following people have generously donated their time to the
 329 development of this module:
 330
 331 =over 4
 332
 333 =item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any>
 334
 335 =item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration
 336
 337 =back
 338
 339 Work to this module has been generously sponsored by:
 340
 341 =over 4
 342
 343 =item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein
 344
 345 =back
 346
 347 =head1 COPYRIGHT AND LICENSE
 348
 349 Copyright 2008 by Brian Cassidy
 350
 351 This library is free software; you can redistribute it and/or modify
 352 it under the same terms as Perl itself.
 353
 354 =head1 SEE ALSO
 355
 356 =over 4
 357
 358 =item * L<Catalyst>
 359
 360 =item * L<Catalyst::Plugin::ConfigLoader::Manual>
 361
 362 =item * L<Config::Any>
 363
 364 =back
 365
 366 =cut
 367
 368 1;