[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;
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
	62	# split the responses into normal and local cfg
	63	my $local_suffix = $c->get_config_local_suffix;
587d381b	64	my ( @cfg, @localcfg );
	65	for ( @$cfg ) {
	66	if ( ( keys %$_ )[ 0 ] =~ m{ $local_suffix \. }xms ) {
f004a98a	67	push @localcfg, $_;
587d381b	68	}
587d381b	69	else {
f004a98a	70	push @cfg, $_;
	71	}
	72	}
587d381b	73
f004a98a	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;
587d381b	92
	93	my ( $file, $config ) = each %$ref;
	94
f004a98a	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;
587d381b	112	my ( $path, $extension ) = $c->get_config_path;
f004a98a	113	my $suffix = $c->get_config_local_suffix;
f004a98a	114	my @extensions = @{ Config::Any->extensions };
587d381b	115
f004a98a	116	my @files;
587d381b	117	if ( $extension ) {
f004a98a	118	next unless grep { $_ eq $extension } @extensions;
4f63af80	119	( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
4f63af80	120	push @files, $path, $local;
587d381b	121	}
587d381b	122	else {
f004a98a	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
7f0397f8	141	=item * C<$ENV{ CATALYST_CONFIG }>
7f0397f8	142
af391898	143	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E>gt>{ file }>
f004a98a	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
af391898	152	DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
	153	and will be removed in the next release.
	154
f004a98a	155	=cut
	156
	157	sub get_config_path {
587d381b	158	my $c = shift;
afce197f	159
afce197f	160	# deprecation notice
587d381b	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	);
afce197f	165	}
afce197f	166
f004a98a	167	my $appname = ref $c \|\| $c;
f004a98a	168	my $prefix = Catalyst::Utils::appprefix( $appname );
7f0397f8	169	my $path = Catalyst::Utils::env_value( $c, 'CONFIG' )
af391898	170	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ file }
587d381b	171	\|\| $c->config->{ file } # to be removed next release
f004a98a	172	\|\| $c->path_to( $prefix );
f004a98a	173
587d381b	174	my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
	175
	176	if ( -d $path ) {
	177	$path =~ s{[\/\\]$}{};
f004a98a	178	$path .= "/$prefix";
f004a98a	179	}
4f63af80	180
587d381b	181	return ( $path, $extension );
f004a98a	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
f004a98a	191	=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
f004a98a	192
7f0397f8	193	=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
7f0397f8	194
af391898	195	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
f004a98a	196
	197	=back
	198
af391898	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
f004a98a	202	=cut
	203
	204	sub get_config_local_suffix {
587d381b	205	my $c = shift;
afce197f	206
afce197f	207	# deprecation notice
587d381b	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	);
afce197f	212	}
afce197f	213
f004a98a	214	my $appname = ref $c \|\| $c;
587d381b	215	my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
af391898	216	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
587d381b	217	\|\| $c->config
587d381b	218	->{ config_local_suffix } # to be remove in the next release
f004a98a	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	},
587d381b	231	grep { ref $config->{ lc $_ } \|\| ref $config->{ $_ } }
587d381b	232	qw( Component Model M View V Controller C )
f004a98a	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
d392c48d	250	walks through the loaded config hash and calls the C<config_substitutions>
d392c48d	251	sub on any string.
f004a98a	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 $_;
d392c48d	260	$c->config_substitutions( $_ );
f004a98a	261	}
	262	);
	263	$v->visit( $c->config );
	264	}
	265
d392c48d	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
af391898	284	C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
af391898	285	Example:
d392c48d	286
af391898	287	MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
d392c48d	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 {
587d381b	296	my $c = shift;
	297	my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions }
	298	\|\| {};
	299	$subs->{ HOME } \|\|= sub { shift->path_to( '' ); };
d392c48d	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
f004a98a	309	=head1 AUTHOR
f004a98a	310
01be879a	311	Brian Cassidy E<lt>bricas@cpan.orgE<gt>
f004a98a	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
80ffa192	336	Copyright 2007 by Brian Cassidy
f004a98a	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
affbca23	347	=item * L<Catalyst::Plugin::ConfigLoader::Manual>
affbca23	348
f004a98a	349	=item * L<Config::Any>
	350
	351	=back
	352
	353	=cut
	354
	355	1;