X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FConfig-Any.git;a=blobdiff_plain;f=lib%2FConfig%2FAny.pm;h=301e006e7887bdeb6ab779343155b6035fb0487d;hp=d097776740f4cd52374ffbe04083cda79eb06b92;hb=48e4a267ac83f85a46ee54c53052f8831752acac;hpb=89706e8e580604123ebf0930c88286eabb2c3d09 diff --git a/lib/Config/Any.pm b/lib/Config/Any.pm index d097776..301e006 100644 --- a/lib/Config/Any.pm +++ b/lib/Config/Any.pm @@ -1,12 +1,12 @@ package Config::Any; -# $Id: $ -use warnings; + use strict; +use warnings; + use Carp; use Module::Pluggable::Object (); -use English qw(-no_match_vars); -our $VERSION = '0.04'; +our $VERSION = '0.09_02'; =head1 NAME @@ -14,21 +14,21 @@ Config::Any - Load configuration from different file formats, transparently =head1 VERSION -This document describes Config::Any version 0.0.4 +This document describes Config::Any version 0.09_02 =head1 SYNOPSIS use Config::Any; - my $cfg = Config::Any->load_stems({stems => \@filepath_stems, ... }); - # or - my $cfg = Config::Any->load_files({files => \@filepaths, ... }); + my $cfg = Config::Any->load_stems({stems => \@filepath_stems, ... }); + # or + my $cfg = Config::Any->load_files({files => \@filepaths, ... }); - for (@$cfg) { - my ($filename, $config) = each %$_; - $class->config($config); - warn "loaded config from file: $filename"; - } + for (@$cfg) { + my ($filename, $config) = each %$_; + $class->config($config); + warn "loaded config from file: $filename"; + } =head1 DESCRIPTION @@ -48,11 +48,11 @@ configuration formats. =cut -=head2 load_files( ) +=head2 load_files( \%args ) - Config::Any->load_files({files => \@files]}); - Config::Any->load_files({files => \@files, filter => \&filter}); - Config::Any->load_files({files => \@files, use_ext => 1}); + Config::Any->load_files( { files => \@files } ); + Config::Any->load_files( { files => \@files, filter => \&filter } ); + Config::Any->load_files( { files => \@files, use_ext => 1 } ); C attempts to load configuration from the list of files passed in the C parameter, if the file exists. @@ -69,27 +69,36 @@ be aware that you will lose flexibility -- for example, a file called C or C would be. +C also supports a 'force_plugins' parameter, whose value should be an +arrayref of plugin names like C. Its intended use is to allow the use +of a non-standard file extension while forcing it to be offered to a particular parser. +It is not compatible with 'use_ext'. + +You can supply a C hashref to pass special options to a particular +parser object. Example: + + Config::Any->load_files( { files => \@files, driver_args => { + General => { -LowerCaseNames => 1 } + } ) + =cut sub load_files { - my ($class, $args) = @_; - return unless defined $args; - unless (exists $args->{files}) { - warn "no files specified"; + my ( $class, $args ) = @_; + + unless ( $args && exists $args->{ files } ) { + warn "No files specified!"; return; } - my $files = [ grep { -f $_ } @{$args->{files}} ]; - my $filter_cb = delete $args->{filter}; - my $use_ext = delete $args->{use_ext}; - return $class->_load($files, $filter_cb, $use_ext); + return $class->_load( $args ); } -=head2 load_stems( ) +=head2 load_stems( \%args ) - Config::Any->load_stems({stems => \@stems]}); - Config::Any->load_stems({stems => \@stems, filter => \&filter}); - Config::Any->load_stems({stems => \@stems, use_ext => 1}); + Config::Any->load_stems( { stems => \@stems } ); + Config::Any->load_stems( { stems => \@stems, filter => \&filter } ); + Config::Any->load_stems( { stems => \@stems, use_ext => 1 } ); C attempts to load configuration from a list of files which it generates by combining the filename stems list passed in the C parameter with the @@ -101,74 +110,94 @@ parameters. Please read the C documentation before using this meth =cut sub load_stems { - my ($class, $args) = @_; - return unless defined $args; - unless (exists $args->{stems}) { - warn "no stems specified"; + my ( $class, $args ) = @_; + + unless ( $args && exists $args->{ stems } ) { + warn "No stems specified!"; return; } - - my $filter_cb = delete $args->{filter}; - my $use_ext = delete $args->{use_ext}; - my $stems = $args->{stems}; + + my $stems = delete $args->{ stems }; my @files; - STEM: - for my $s (@$stems) { - EXT: - for my $ext ($class->extensions) { - my $file = "$s.$ext"; - next EXT unless -f $file; - push @files, $file; - last EXT; + for my $s ( @$stems ) { + for my $ext ( $class->extensions ) { + push @files, "$s.$ext"; } } - return $class->_load(\@files, $filter_cb, $use_ext); + + $args->{ files } = \@files; + return $class->_load( $args ); } -# this is where we do the real work -# it's a private class-method because users should use the interface described -# in the POD. sub _load { - my ($class, $files_ref, $filter_cb, $use_ext) = @_; - croak "_load requires a arrayref of file paths" unless defined $files_ref; - - my $final_configs = []; - my $originally_loaded = {}; - my %files = map { $_ => 1 } @$files_ref; - - for my $loader ( $class->plugins ) { - last unless keys %files; -# warn "loader: $loader\n"; - my %ext = map { $_ => 1 } $loader->extensions; - FILE: - for my $filename (keys %files) { - if (defined $use_ext) { -# warn "using file extension to decide which loader to use for file $filename\n"; - my $matched_ext = 0; - EXT: - for my $e (keys %ext) { -# warn "trying ext $e\n"; - next EXT unless $filename =~ m{ \. $e \z }xms; -# warn "filename $filename matched extension $e\n"; - next FILE unless exists $ext{$e}; - $matched_ext = 1; - } - next FILE unless $matched_ext; + my ( $class, $args ) = @_; + croak "_load requires a arrayref of file paths" unless $args->{ files }; + + my $force = defined $args->{ force_plugins }; + if ( !$force and !defined $args->{ use_ext } ) { + warn + "use_ext argument was not explicitly set, as of 0.09, this is true by default"; + $args->{ use_ext } = 1; + } + + # figure out what plugins we're using + my @plugins = $force ? @{ $args->{ force_plugins } } : $class->plugins; + + # map extensions if we have to + my ( %extension_lut, $extension_re ); + my $use_ext_lut = !$force && $args->{ use_ext }; + if ( $use_ext_lut ) { + for my $plugin ( @plugins ) { + $extension_lut{ $_ } = $plugin for $plugin->extensions; + } + + $extension_re = join( '|', keys %extension_lut ); + } + + # map args to plugins + my $base_class = __PACKAGE__; + my %loader_args; + for my $plugin ( @plugins ) { + $plugin =~ m{^$base_class\::(.+)}; + $loader_args{ $plugin } = $args->{ driver_args }->{ $1 } || {}; + } + + my @results; + + for my $filename ( @{ $args->{ files } } ) { + + # don't even bother if it's not there + next unless -f $filename; + + my @try_plugins = @plugins; + + if ( $use_ext_lut ) { + $filename =~ m{\.($extension_re)\z}; + next unless $1; + @try_plugins = $extension_lut{ $1 }; + } + + for my $loader ( @try_plugins ) { + next unless $loader->is_supported; + my @configs + = eval { $loader->load( $filename, $loader_args{ $loader } ); }; + + # fatal error if we used extension matching + croak "Error parsing file: $filename" if $@ and $use_ext_lut; + next if $@ or !@configs; + + # post-process config with a filter callback + if ( $args->{ filter } ) { + $args->{ filter }->( $_ ) for @configs; } - my $config; - eval { - $config = $loader->load( $filename ); - }; - next if $EVAL_ERROR; - next if !$config; - delete $files{$filename}; -# warn "loader $loader loaded file $filename\n"; - $filter_cb->( $config ) if defined $filter_cb; - push @$final_configs, { $filename => $config }; + push @results, + { $filename => @configs == 1 ? $configs[ 0 ] : \@configs }; + last; } } - $final_configs; + + return \@results; } =head2 finder( ) @@ -181,12 +210,12 @@ more information. =cut sub finder { - my $class = shift; + my $class = shift; my $finder = Module::Pluggable::Object->new( search_path => [ __PACKAGE__ ], require => 1 ); - $finder; + return $finder; } =head2 plugins( ) @@ -212,14 +241,14 @@ parameter to those methods. sub extensions { my $class = shift; my @ext = map { $_->extensions } $class->plugins; - return wantarray ? @ext : [@ext]; + return wantarray ? @ext : \@ext; } =head1 DIAGNOSTICS =over -=item C or C +=item C or C The C and C methods will issue this warning if called with an empty list of files/stems to load. @@ -263,7 +292,7 @@ L. =head1 AUTHOR -Joel Bernstein C<< >> +Joel Bernstein Erataxis@cpan.orgE =head1 CONTRIBUTORS @@ -273,9 +302,12 @@ module by Brian Cassidy C<< >>. With ideas and support from Matt S Trout C<< >>. +Further enhancements suggested by Evan Kaufman C<< >>. + =head1 LICENCE AND COPYRIGHT Copyright (c) 2006, Portugal Telecom C<< http://www.sapo.pt/ >>. All rights reserved. +Portions copyright 2007, Joel Bernstein C<< >>. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. @@ -310,5 +342,4 @@ L =cut -1; # Magic true value required at end of module - +"Drink more beer";