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