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