[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.

=cut

sub get_config_path {
    my $c = shift;


    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->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

=cut

sub get_config_local_suffix {
    my $c = shift;

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