[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.22';

=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 }>.
For example, to pass arguments to L<Config::General>, use the following:

    __PACKAGE__->config( 'Plugin::ConfigLoader' => {
        driver => {
            'General' => { -LowerCaseNames => 1 }
        }
    } );

See L<Config::Any>'s C<driver_args> parameter for more information.

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 Plugin )
    );

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