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