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