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

=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( 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.

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

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