[catagits/Catalyst-Plugin-ConfigLoader.git] / lib / Catalyst / Plugin / ConfigLoader.pm

package Catalyst::Plugin::ConfigLoader;

use strict;
use warnings;

use Config::Any;
use NEXT;
use Data::Visitor::Callback;
use Catalyst::Utils ();

our $VERSION = '0.19';

=head1 NAME

Catalyst::Plugin::ConfigLoader - Load config files of various types

=head1 SYNOPSIS

    package MyApp;
    
    # ConfigLoader should be first in your list so
    # other plugins can get the config information
    use Catalyst qw( ConfigLoader ... );
    
    # by default myapp.* will be loaded
    # you can specify a file if you'd like
    __PACKAGE__->config( 'Plugin::ConfigLoader' => { file => 'config.yaml' } );    

=head1 DESCRIPTION

This module will attempt to load find and load a configuration
file of various types. Currently it supports YAML, JSON, XML,
INI and Perl formats. Special configuration for a particular driver format can
be stored in C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ driver }>.

To support the distinction between development and production environments,
this module will also attemp to load a local config (e.g. myapp_local.yaml)
which will override any duplicate settings.

=head1 METHODS

=head2 setup( )

This method is automatically called by Catalyst's setup routine. It will
attempt to use each plugin and, once a file has been successfully
loaded, set the C<config()> section. 

=cut

sub setup {
    my $c     = shift;
    my @files = $c->find_files;
    my $cfg   = Config::Any->load_files( {
        files       => \@files, 
        filter      => \&_fix_syntax,
        use_ext     => 1,
        driver_args => $c->config->{'Plugin::ConfigLoader'}->{driver} || {},
    } );

    # split the responses into normal and local cfg
    my $local_suffix = $c->get_config_local_suffix;
    my( @cfg, @localcfg );
    for( @$cfg ) {
        if( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) {
            push @localcfg, $_;
        } else {
            push @cfg, $_;
        }
    }
    
    # load all the normal cfgs, then the local cfgs last so they can override
    # normal cfgs
    $c->load_config( $_ ) for @cfg, @localcfg;

    $c->finalize_config;
    $c->NEXT::setup( @_ );
}

=head2 load_config

This method handles loading the configuration data into the Catalyst
context object. It does not return a value.

=cut

sub load_config {
    my $c   = shift;
    my $ref = shift;
    
    my( $file, $config ) = each %$ref;
    
    $c->config( $config );
    $c->log->debug( qq(Loaded Config "$file") )
        if $c->debug;

    return;
}

=head2 find_files

This method determines the potential file paths to be used for config loading.
It returns an array of paths (up to the filename less the extension) to pass to
L<Config::Any|Config::Any> for loading.

=cut

sub find_files {
    my $c = shift;
    my( $path, $extension ) = $c->get_config_path;
    my $suffix     = $c->get_config_local_suffix;
    my @extensions = @{ Config::Any->extensions };
    
    my @files;
    if ($extension) {
        next unless grep { $_ eq $extension } @extensions;
        ( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
        push @files, $path, $local;
    } else {
        @files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
    }

    @files;
}

=head2 get_config_path

This method determines the path, filename prefix and file extension to be used
for config loading. It returns the path (up to the filename less the
extension) to check and the specific extension to use (if it was specified).

The order of preference is specified as:

=over 4

=item * C<$ENV{ MYAPP_CONFIG }>

=item * C<$ENV{ CATALYST_CONFIG }>

=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E>gt>{ file }>

=item * C<$c-E<gt>path_to( $application_prefix )>

=back

If either of the first two user-specified options are directories, the
application prefix will be added on to the end of the path.

DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
and will be removed in the next release.

=cut

sub get_config_path {
    my $c       = shift;

    # deprecation notice
    if( exists $c->config->{ file } ) {
        $c->log->warn( q("file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }") );
    }

    my $appname = ref $c || $c;
    my $prefix  = Catalyst::Utils::appprefix( $appname );
    my $path    = Catalyst::Utils::env_value( $c, 'CONFIG' )
        || $c->config->{ 'Plugin::ConfigLoader' }->{ file }
        || $c->config->{ file } # to be removed next release
        || $c->path_to( $prefix );

    my( $extension ) = ( $path =~ m{\.(.{1,4})$} );
    
    if( -d $path ) {
        $path  =~ s{[\/\\]$}{};
        $path .= "/$prefix";
    }

    return( $path, $extension );
}

=head2 get_config_local_suffix

Determines the suffix of files used to override the main config. By default
this value is C<local>, but it can be specified in the following order of preference:

=over 4

=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>

=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>

=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>

=back

DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ config_local_suffix }> is deprecated
and will be removed in the next release.

=cut

sub get_config_local_suffix {
    my $c       = shift;

    # deprecation notice
    if( exists $c->config->{ config_local_suffix } ) {
        $c->log->warn( q("config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }") );
    }

    my $appname = ref $c || $c;
    my $suffix  = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
        || $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
        || $c->config->{ config_local_suffix } # to be remove in the next release
        || 'local';

    return $suffix;
}

sub _fix_syntax {
    my $config     = shift;
    my @components = (
        map +{
            prefix => $_ eq 'Component' ? '' : $_ . '::',
            values => delete $config->{ lc $_ } || delete $config->{ $_ }
        },
        grep {
            ref $config->{ lc $_ } || ref $config->{ $_ }
        }
        qw( Component Model M View V Controller C )
    );

    foreach my $comp ( @components ) {
        my $prefix = $comp->{ prefix };
        foreach my $element ( keys %{ $comp->{ values } } ) {
            $config->{ "$prefix$element" } = $comp->{ values }->{ $element };
        }
    }
}

=head2 finalize_config

This method is called after the config file is loaded. It can be
used to implement tuning of config values that can only be done
at runtime. If you need to do this to properly configure any
plugins, it's important to load ConfigLoader before them.
ConfigLoader provides a default finalize_config method which
walks through the loaded config hash and calls the C<config_substitutions>
sub on any string.

=cut

sub finalize_config {
    my $c = shift;
    my $v = Data::Visitor::Callback->new(
        plain_value => sub {
            return unless defined $_;
            $c->config_substitutions( $_ );
        }
    );
    $v->visit( $c->config );
}

=head2 config_substitutions( $value )

This method substitutes macros found with calls to a function. There are three
default macros:

=over 4

=item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>

=item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>

=item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
C<__DATA__> as a config value, for example)

=back

The parameter list is split on comma (C<,>). You can override this method to
do your own string munging, or you can define your own macros in
C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
Example:

    MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
        baz => sub { my $c = shift; qux( @_ ); }
    }

The above will respond to C<__baz(x,y)__> in config strings.

=cut

sub config_substitutions {
    my $c = shift;
    my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions } || {};
    $subs->{ HOME } ||= sub { shift->path_to( '' ); };
    $subs->{ path_to } ||= sub { shift->path_to( @_ ); };
    $subs->{ literal } ||= sub { return $_[ 1 ]; };
    my $subsre = join( '|', keys %$subs );

    for ( @_ ) {
        s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $c, $2 ? split( /,/, $2 ) : () ) }eg;
    }
}


=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 CONTRIBUTORS

The following people have generously donated their time to the
development of this module:

=over 4

=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any>

=item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration

=back

Work to this module has been generously sponsored by: 

=over 4

=item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein

=back

=head1 COPYRIGHT AND LICENSE

Copyright 2007 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Catalyst::Plugin::ConfigLoader::Manual>

=item * L<Config::Any>

=back

=cut

1;
Commit	Line	Data
f004a98a	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;
7f0397f8	9	use Catalyst::Utils ();
f004a98a	10
4f63af80	11	our $VERSION = '0.19';
f004a98a	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
3231a8d0	27	__PACKAGE__->config( 'Plugin::ConfigLoader' => { file => 'config.yaml' } );
f004a98a	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,
3231a8d0	33	INI and Perl formats. Special configuration for a particular driver format can
3231a8d0	34	be stored in C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ driver }>.
f004a98a	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( {
3231a8d0	54	files => \@files,
	55	filter => \&_fix_syntax,
	56	use_ext => 1,
	57	driver_args => $c->config->{'Plugin::ConfigLoader'}->{driver} \|\| {},
f004a98a	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;
4f63af80	116	( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
4f63af80	117	push @files, $path, $local;
f004a98a	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
7f0397f8	137	=item * C<$ENV{ CATALYST_CONFIG }>
7f0397f8	138
af391898	139	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E>gt>{ file }>
f004a98a	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
af391898	148	DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
	149	and will be removed in the next release.
	150
f004a98a	151	=cut
	152
	153	sub get_config_path {
	154	my $c = shift;
afce197f	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
f004a98a	161	my $appname = ref $c \|\| $c;
f004a98a	162	my $prefix = Catalyst::Utils::appprefix( $appname );
7f0397f8	163	my $path = Catalyst::Utils::env_value( $c, 'CONFIG' )
af391898	164	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ file }
af391898	165	\|\| $c->config->{ file } # to be removed next release
f004a98a	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	}
4f63af80	174
f004a98a	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
f004a98a	185	=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
f004a98a	186
7f0397f8	187	=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
7f0397f8	188
af391898	189	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
f004a98a	190
	191	=back
	192
af391898	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
f004a98a	196	=cut
	197
	198	sub get_config_local_suffix {
	199	my $c = shift;
afce197f	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
f004a98a	206	my $appname = ref $c \|\| $c;
7f0397f8	207	my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
af391898	208	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
af391898	209	\|\| $c->config->{ config_local_suffix } # to be remove in the next release
f004a98a	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
d392c48d	243	walks through the loaded config hash and calls the C<config_substitutions>
d392c48d	244	sub on any string.
f004a98a	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 $_;
d392c48d	253	$c->config_substitutions( $_ );
f004a98a	254	}
	255	);
	256	$v->visit( $c->config );
	257	}
	258
d392c48d	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
af391898	277	C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
af391898	278	Example:
d392c48d	279
af391898	280	MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
d392c48d	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;
af391898	290	my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions } \|\| {};
d392c48d	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
f004a98a	302	=head1 AUTHOR
f004a98a	303
01be879a	304	Brian Cassidy E<lt>bricas@cpan.orgE<gt>
f004a98a	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
80ffa192	329	Copyright 2007 by Brian Cassidy
f004a98a	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
affbca23	340	=item * L<Catalyst::Plugin::ConfigLoader::Manual>
affbca23	341
f004a98a	342	=item * L<Config::Any>
	343
	344	=back
	345
	346	=cut
	347
	348	1;