[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' } );    

  In the file, assuming it's in YAML format:

    foo: bar

  Accessible through the context object, or the class itself

   $c->config->{foo}    # bar
   MyApp->config->{foo} # bar

=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
7c53420c	29	In the file, assuming it's in YAML format:
	30
	31	foo: bar
	32
	33	Accessible through the context object, or the class itself
	34
	35	$c->config->{foo} # bar
	36	MyApp->config->{foo} # bar
	37
f004a98a	38	=head1 DESCRIPTION
	39
	40	This module will attempt to load find and load a configuration
	41	file of various types. Currently it supports YAML, JSON, XML,
3231a8d0	42	INI and Perl formats. Special configuration for a particular driver format can
3231a8d0	43	be stored in C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ driver }>.
f004a98a	44
	45	To support the distinction between development and production environments,
	46	this module will also attemp to load a local config (e.g. myapp_local.yaml)
	47	which will override any duplicate settings.
	48
	49	=head1 METHODS
	50
	51	=head2 setup( )
	52
	53	This method is automatically called by Catalyst's setup routine. It will
	54	attempt to use each plugin and, once a file has been successfully
	55	loaded, set the C<config()> section.
	56
	57	=cut
	58
	59	sub setup {
	60	my $c = shift;
	61	my @files = $c->find_files;
587d381b	62	my $cfg = Config::Any->load_files(
	63	{ files => \@files,
	64	filter => \&_fix_syntax,
	65	use_ext => 1,
	66	driver_args => $c->config->{ 'Plugin::ConfigLoader' }->{ driver }
	67	\|\| {},
	68	}
	69	);
90c108e6	70	# map the array of hashrefs to a simple hash
	71	my %configs = map { %$_ } @$cfg;
	72
f004a98a	73	# split the responses into normal and local cfg
f004a98a	74	my $local_suffix = $c->get_config_local_suffix;
90c108e6	75	my ( @main, @locals );
	76	for ( sort keys %configs ) {
	77	if ( m{$local_suffix\.}ms ) {
	78	push @locals, $_;
587d381b	79	}
587d381b	80	else {
90c108e6	81	push @main, $_;
f004a98a	82	}
f004a98a	83	}
587d381b	84
f004a98a	85	# load all the normal cfgs, then the local cfgs last so they can override
f004a98a	86	# normal cfgs
90c108e6	87	$c->load_config( { $_ => $configs{ $_ } } ) for @main, @locals;
f004a98a	88
	89	$c->finalize_config;
	90	$c->NEXT::setup( @_ );
	91	}
	92
	93	=head2 load_config
	94
	95	This method handles loading the configuration data into the Catalyst
	96	context object. It does not return a value.
	97
	98	=cut
	99
	100	sub load_config {
	101	my $c = shift;
	102	my $ref = shift;
587d381b	103
e538c6f7	104	my ( $file, $config ) = %$ref;
587d381b	105
f004a98a	106	$c->config( $config );
	107	$c->log->debug( qq(Loaded Config "$file") )
	108	if $c->debug;
	109
	110	return;
	111	}
	112
	113	=head2 find_files
	114
	115	This method determines the potential file paths to be used for config loading.
	116	It returns an array of paths (up to the filename less the extension) to pass to
	117	L<Config::Any\|Config::Any> for loading.
	118
	119	=cut
	120
	121	sub find_files {
	122	my $c = shift;
587d381b	123	my ( $path, $extension ) = $c->get_config_path;
f004a98a	124	my $suffix = $c->get_config_local_suffix;
f004a98a	125	my @extensions = @{ Config::Any->extensions };
587d381b	126
f004a98a	127	my @files;
587d381b	128	if ( $extension ) {
f004a98a	129	next unless grep { $_ eq $extension } @extensions;
4f63af80	130	( my $local = $path ) =~ s{\.$extension}{_$suffix.$extension};
4f63af80	131	push @files, $path, $local;
587d381b	132	}
587d381b	133	else {
f004a98a	134	@files = map { ( "$path.$_", "${path}_${suffix}.$_" ) } @extensions;
f004a98a	135	}
f004a98a	136	@files;
	137	}
	138
	139	=head2 get_config_path
	140
	141	This method determines the path, filename prefix and file extension to be used
	142	for config loading. It returns the path (up to the filename less the
	143	extension) to check and the specific extension to use (if it was specified).
	144
	145	The order of preference is specified as:
	146
	147	=over 4
	148
	149	=item * C<$ENV{ MYAPP_CONFIG }>
	150
7f0397f8	151	=item * C<$ENV{ CATALYST_CONFIG }>
7f0397f8	152
eb05f0bf	153	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ file }>
f004a98a	154
	155	=item * C<$c-E<gt>path_to( $application_prefix )>
	156
	157	=back
	158
	159	If either of the first two user-specified options are directories, the
	160	application prefix will be added on to the end of the path.
	161
af391898	162	DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ file }> is deprecated
	163	and will be removed in the next release.
	164
f004a98a	165	=cut
	166
	167	sub get_config_path {
587d381b	168	my $c = shift;
afce197f	169
afce197f	170	# deprecation notice
587d381b	171	if ( exists $c->config->{ file } ) {
587d381b	172	$c->log->warn(
77d8f18e	173	q(*** "file" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ file }")
587d381b	174	);
25c714a2	175	sleep( 3 );
afce197f	176	}
afce197f	177
f004a98a	178	my $appname = ref $c \|\| $c;
f004a98a	179	my $prefix = Catalyst::Utils::appprefix( $appname );
7f0397f8	180	my $path = Catalyst::Utils::env_value( $c, 'CONFIG' )
af391898	181	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ file }
587d381b	182	\|\| $c->config->{ file } # to be removed next release
f004a98a	183	\|\| $c->path_to( $prefix );
f004a98a	184
587d381b	185	my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
	186
	187	if ( -d $path ) {
	188	$path =~ s{[\/\\]$}{};
f004a98a	189	$path .= "/$prefix";
f004a98a	190	}
4f63af80	191
587d381b	192	return ( $path, $extension );
f004a98a	193	}
	194
	195	=head2 get_config_local_suffix
	196
	197	Determines the suffix of files used to override the main config. By default
	198	this value is C<local>, but it can be specified in the following order of preference:
	199
	200	=over 4
	201
f004a98a	202	=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }>
f004a98a	203
7f0397f8	204	=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }>
7f0397f8	205
af391898	206	=item * C<$c-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ config_local_suffix }>
f004a98a	207
	208	=back
	209
af391898	210	DEPRECATION NOTICE: C<$c-E<gt>config-E<gt>{ config_local_suffix }> is deprecated
	211	and will be removed in the next release.
	212
f004a98a	213	=cut
	214
	215	sub get_config_local_suffix {
587d381b	216	my $c = shift;
afce197f	217
afce197f	218	# deprecation notice
587d381b	219	if ( exists $c->config->{ config_local_suffix } ) {
587d381b	220	$c->log->warn(
25c714a2	221	q(*** "config_local_suffix" config parameter has been deprecated in favor of "$c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }")
587d381b	222	);
25c714a2	223	sleep( 3 );
afce197f	224	}
afce197f	225
f004a98a	226	my $appname = ref $c \|\| $c;
587d381b	227	my $suffix = Catalyst::Utils::env_value( $c, 'CONFIG_LOCAL_SUFFIX' )
af391898	228	\|\| $c->config->{ 'Plugin::ConfigLoader' }->{ config_local_suffix }
587d381b	229	\|\| $c->config
587d381b	230	->{ config_local_suffix } # to be remove in the next release
f004a98a	231	\|\| 'local';
	232
	233	return $suffix;
	234	}
	235
	236	sub _fix_syntax {
	237	my $config = shift;
	238	my @components = (
	239	map +{
	240	prefix => $_ eq 'Component' ? '' : $_ . '::',
	241	values => delete $config->{ lc $_ } \|\| delete $config->{ $_ }
	242	},
587d381b	243	grep { ref $config->{ lc $_ } \|\| ref $config->{ $_ } }
587d381b	244	qw( Component Model M View V Controller C )
f004a98a	245	);
	246
	247	foreach my $comp ( @components ) {
	248	my $prefix = $comp->{ prefix };
	249	foreach my $element ( keys %{ $comp->{ values } } ) {
	250	$config->{ "$prefix$element" } = $comp->{ values }->{ $element };
	251	}
	252	}
	253	}
	254
	255	=head2 finalize_config
	256
	257	This method is called after the config file is loaded. It can be
	258	used to implement tuning of config values that can only be done
	259	at runtime. If you need to do this to properly configure any
	260	plugins, it's important to load ConfigLoader before them.
	261	ConfigLoader provides a default finalize_config method which
d392c48d	262	walks through the loaded config hash and calls the C<config_substitutions>
d392c48d	263	sub on any string.
f004a98a	264
	265	=cut
	266
	267	sub finalize_config {
	268	my $c = shift;
	269	my $v = Data::Visitor::Callback->new(
	270	plain_value => sub {
	271	return unless defined $_;
d392c48d	272	$c->config_substitutions( $_ );
f004a98a	273	}
	274	);
	275	$v->visit( $c->config );
	276	}
	277
d392c48d	278	=head2 config_substitutions( $value )
	279
	280	This method substitutes macros found with calls to a function. There are three
	281	default macros:
	282
	283	=over 4
	284
	285	=item * C<__HOME__> - replaced with C<$c-E<gt>path_to('')>
	286
	287	=item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_to('foo/bar')>
	288
	289	=item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use
	290	C<__DATA__> as a config value, for example)
	291
	292	=back
	293
	294	The parameter list is split on comma (C<,>). You can override this method to
	295	do your own string munging, or you can define your own macros in
af391898	296	C<MyApp-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ substitutions }>.
af391898	297	Example:
d392c48d	298
af391898	299	MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = {
d392c48d	300	baz => sub { my $c = shift; qux( @_ ); }
	301	}
	302
	303	The above will respond to C<__baz(x,y)__> in config strings.
	304
	305	=cut
	306
	307	sub config_substitutions {
587d381b	308	my $c = shift;
	309	my $subs = $c->config->{ 'Plugin::ConfigLoader' }->{ substitutions }
	310	\|\| {};
	311	$subs->{ HOME } \|\|= sub { shift->path_to( '' ); };
d392c48d	312	$subs->{ path_to } \|\|= sub { shift->path_to( @_ ); };
	313	$subs->{ literal } \|\|= sub { return $_[ 1 ]; };
	314	my $subsre = join( '\|', keys %$subs );
	315
	316	for ( @_ ) {
	317	s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $c, $2 ? split( /,/, $2 ) : () ) }eg;
	318	}
	319	}
	320
f004a98a	321	=head1 AUTHOR
f004a98a	322
01be879a	323	Brian Cassidy E<lt>bricas@cpan.orgE<gt>
f004a98a	324
	325	=head1 CONTRIBUTORS
	326
	327	The following people have generously donated their time to the
	328	development of this module:
	329
	330	=over 4
	331
	332	=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt> - Rewrite to use L<Config::Any>
	333
	334	=item * David Kamholz E<lt>dkamholz@cpan.orgE<gt> - L<Data::Visitor> integration
	335
	336	=back
	337
	338	Work to this module has been generously sponsored by:
	339
	340	=over 4
	341
	342	=item * Portugal Telecom L<http://www.sapo.pt/> - Work done by Joel Bernstein
	343
	344	=back
	345
	346	=head1 COPYRIGHT AND LICENSE
	347
90c108e6	348	Copyright 2008 by Brian Cassidy
f004a98a	349
	350	This library is free software; you can redistribute it and/or modify
	351	it under the same terms as Perl itself.
	352
	353	=head1 SEE ALSO
	354
	355	=over 4
	356
	357	=item * L<Catalyst>
	358
affbca23	359	=item * L<Catalyst::Plugin::ConfigLoader::Manual>
affbca23	360
f004a98a	361	=item * L<Config::Any>
	362
	363	=back
	364
	365	=cut
	366
	367	1;