[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.20';

=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 }
                || {},
        }
    );

    # map the array of hashrefs to a simple hash
    my %configs = map { %$_ } @$cfg;

    # split the responses into normal and local cfg
    my $local_suffix = $c->get_config_local_suffix;
    my ( @main, @locals );
    for ( sort keys %configs ) {
        if ( m{$local_suffix\.}ms ) {
            push @locals, $_;
        }
        else {
            push @main, $_;
        }
    }

    # load all the normal cfgs, then the local cfgs last so they can override
    # normal cfgs
    $c->load_config( { $_ => $configs{ $_ } } ) for @main, @locals;

    $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 ) = %$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 }")
        );
        sleep( 3 );
    }

    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 }")
        );
        sleep( 3 );
    }

    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 2008 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
90c108e6	11	our $VERSION = '0.20';
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;
587d381b	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	);
f004a98a	61
90c108e6	62	# map the array of hashrefs to a simple hash
	63	my %configs = map { %$_ } @$cfg;
	64
f004a98a	65	# split the responses into normal and local cfg
f004a98a	66	my $local_suffix = $c->get_config_local_suffix;
90c108e6	67	my ( @main, @locals );
	68	for ( sort keys %configs ) {
	69	if ( m{$local_suffix\.}ms ) {
	70	push @locals, $_;
587d381b	71	}
587d381b	72	else {
90c108e6	73	push @main, $_;
f004a98a	74	}
f004a98a	75	}
587d381b	76
f004a98a	77	# load all the normal cfgs, then the local cfgs last so they can override
f004a98a	78	# normal cfgs
90c108e6	79	$c->load_config( { $_ => $configs{ $_ } } ) for @main, @locals;
f004a98a	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;
587d381b	95
e538c6f7	96	my ( $file, $config ) = %$ref;
587d381b	97
f004a98a	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;
587d381b	115	my ( $path, $extension ) = $c->get_config_path;
f004a98a	116	my $suffix = $c->get_config_local_suffix;
f004a98a	117	my @extensions = @{ Config::Any->extensions };
587d381b	118
f004a98a	119	my @files;
587d381b	120	if ( $extension ) {
f004a98a	121	next unless grep { $_ eq $extension } @extensions;
4f63af80	122	( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
4f63af80	123	push @files, $path, $local;
587d381b	124	}
587d381b	125	else {
f004a98a	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
7f0397f8	144	=item * C<$ENV{ CATALYST_CONFIG }>
7f0397f8	145
eb05f0bf	146	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ file }>
f004a98a	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
af391898	155	DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
	156	and will be removed in the next release.
	157
f004a98a	158	=cut
	159
	160	sub get_config_path {
587d381b	161	my $c = shift;
afce197f	162
afce197f	163	# deprecation notice
587d381b	164	if ( exists $c->config->{ file } ) {
587d381b	165	$c->log->warn(
77d8f18e	166	q(*** "file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }")
587d381b	167	);
25c714a2	168	sleep( 3 );
afce197f	169	}
afce197f	170
f004a98a	171	my $appname = ref $c \|\| $c;
f004a98a	172	my $prefix = Catalyst::Utils::appprefix( $appname );
7f0397f8	173	my $path = Catalyst::Utils::env_value( $c, 'CONFIG' )
af391898	174	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ file }
587d381b	175	\|\| $c->config->{ file } # to be removed next release
f004a98a	176	\|\| $c->path_to( $prefix );
f004a98a	177
587d381b	178	my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
	179
	180	if ( -d $path ) {
	181	$path =~ s{[\/\\]$}{};
f004a98a	182	$path .= "/$prefix";
f004a98a	183	}
4f63af80	184
587d381b	185	return ( $path, $extension );
f004a98a	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
f004a98a	195	=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
f004a98a	196
7f0397f8	197	=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
7f0397f8	198
af391898	199	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
f004a98a	200
	201	=back
	202
af391898	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
f004a98a	206	=cut
	207
	208	sub get_config_local_suffix {
587d381b	209	my $c = shift;
afce197f	210
afce197f	211	# deprecation notice
587d381b	212	if ( exists $c->config->{ config_local_suffix } ) {
587d381b	213	$c->log->warn(
25c714a2	214	q(*** "config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }")
587d381b	215	);
25c714a2	216	sleep( 3 );
afce197f	217	}
afce197f	218
f004a98a	219	my $appname = ref $c \|\| $c;
587d381b	220	my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
af391898	221	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
587d381b	222	\|\| $c->config
587d381b	223	->{ config_local_suffix } # to be remove in the next release
f004a98a	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	},
587d381b	236	grep { ref $config->{ lc $_ } \|\| ref $config->{ $_ } }
587d381b	237	qw( Component Model M View V Controller C )
f004a98a	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
d392c48d	255	walks through the loaded config hash and calls the C<config_substitutions>
d392c48d	256	sub on any string.
f004a98a	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 $_;
d392c48d	265	$c->config_substitutions( $_ );
f004a98a	266	}
	267	);
	268	$v->visit( $c->config );
	269	}
	270
d392c48d	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
af391898	289	C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
af391898	290	Example:
d392c48d	291
af391898	292	MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
d392c48d	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 {
587d381b	301	my $c = shift;
	302	my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions }
	303	\|\| {};
	304	$subs->{ HOME } \|\|= sub { shift->path_to( '' ); };
d392c48d	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
f004a98a	314	=head1 AUTHOR
f004a98a	315
01be879a	316	Brian Cassidy E<lt>bricas@cpan.orgE<gt>
f004a98a	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
90c108e6	341	Copyright 2008 by Brian Cassidy
f004a98a	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
affbca23	352	=item * L<Catalyst::Plugin::ConfigLoader::Manual>
affbca23	353
f004a98a	354	=item * L<Config::Any>
	355
	356	=back
	357
	358	=cut
	359
	360	1;