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