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