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

=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 ) = each %$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;
        push @files, $path, "${path}_${suffix}";
    } 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 }") );
    }

    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 }") );
    }

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