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