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.19';
  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 =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. Special configuration for a particular driver format can
  34 be stored in C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ driver }>.
  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;
  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     );
  61
  62     # split the responses into normal and local cfg
  63     my $local_suffix = $c->get_config_local_suffix;
  64     my ( @cfg, @localcfg );
  65     for ( @$cfg ) {
  66         if ( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) {
  67             push @localcfg, $_;
  68         }
  69         else {
  70             push @cfg, $_;
  71         }
  72     }
  73
  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;
  92
  93     my ( $file, $config ) = %$ref;
  94
  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;
 112     my ( $path, $extension ) = $c->get_config_path;
 113     my $suffix     = $c->get_config_local_suffix;
 114     my @extensions = @{ Config::Any->extensions };
 115
 116     my @files;
 117     if ( $extension ) {
 118         next unless grep { $_ eq $extension } @extensions;
 119         ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
 120         push @files, $path, $local;
 121     }
 122     else {
 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
 141 =item * C<$ENV{ CATALYST_CONFIG }>
 142
 143 =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ file }>
 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
 152 DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
 153 and will be removed in the next release.
 154
 155 =cut
 156
 157 sub get_config_path {
 158     my $c = shift;
 159
 160     # deprecation notice
 161     if ( exists $c->config->{ file } ) {
 162         $c->log->warn(
 163             q(*** "file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }")
 164             sleep( 3 );
 165         );
 166     }
 167
 168     my $appname = ref $c || $c;
 169     my $prefix  = Catalyst::Utils::appprefix( $appname );
 170     my $path    = Catalyst::Utils::env_value( $c, 'CONFIG' )
 171         || $c->config->{ 'Plugin::ConfigLoader' }->{ file }
 172         || $c->config->{ file }    # to be removed next release
 173         || $c->path_to( $prefix );
 174
 175     my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
 176
 177     if ( -d $path ) {
 178         $path =~ s{[\/\\]$}{};
 179         $path .= "/$prefix";
 180     }
 181
 182     return ( $path, $extension );
 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
 192 =item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
 193
 194 =item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
 195
 196 =item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
 197
 198 =back
 199
 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
 203 =cut
 204
 205 sub get_config_local_suffix {
 206     my $c = shift;
 207
 208     # deprecation notice
 209     if ( exists $c->config->{ config_local_suffix } ) {
 210         $c->log->warn(
 211             q("*** config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }")
 212             sleep( 3 );
 213         );
 214     }
 215
 216     my $appname = ref $c || $c;
 217     my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
 218         || $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
 219         || $c->config
 220         ->{ config_local_suffix }    # to be remove in the next release
 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         },
 233         grep { ref $config->{ lc $_ } || ref $config->{ $_ } }
 234             qw( Component Model M View V Controller C )
 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
 252 walks through the loaded config hash and calls the C<config_substitutions>
 253 sub on any string.
 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 $_;
 262             $c->config_substitutions( $_ );
 263         }
 264     );
 265     $v->visit( $c->config );
 266 }
 267
 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
 286 C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
 287 Example:
 288
 289     MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
 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 {
 298     my $c    = shift;
 299     my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions }
 300         || {};
 301     $subs->{ HOME }    ||= sub { shift->path_to( '' ); };
 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
 311 =head1 AUTHOR
 312
 313 Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 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
 338 Copyright 2007 by Brian Cassidy
 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
 349 =item * L<Catalyst::Plugin::ConfigLoader::Manual>
 350
 351 =item * L<Config::Any>
 352
 353 =back
 354
 355 =cut
 356
 357 1;