fix t/64-extfail.t to pass when t/lib is in @INC
[p5sagit/Config-Any.git] / lib / Config / Any.pm
index c7580a2..4033b49 100644 (file)
@@ -1,34 +1,30 @@
 package Config::Any;
-# $Id: $
-use warnings;
+
 use strict;
+use warnings;
+
 use Carp;
 use Module::Pluggable::Object ();
-use English qw(-no_match_vars);
 
-our $VERSION = (qw$Rev: $)[-1];
+our $VERSION = '0.21';
 
 =head1 NAME
 
 Config::Any - Load configuration from different file formats, transparently
 
-=head1 VERSION
-
-This document describes Config::Any version 0.0.4
-
 =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) = %$_;
+        $class->config($config);
+        warn "loaded config from file: $filename";
+    }
 
 =head1 DESCRIPTION
 
@@ -48,11 +44,12 @@ 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 } );
+    Config::Any->load_files( { files => \@files, flatten_to_hash => 1 } );
 
 C<load_files()> attempts to load configuration from the list of files passed in
 the C<files> parameter, if the file exists.
@@ -69,27 +66,40 @@ be aware that you will lose flexibility -- for example, a file called C<myapp.cf
 containing YAML data will not be offered to the YAML plugin, whereas C<myapp.yml>
 or C<myapp.yaml> would be.
 
+When the C<flatten_to_hash> parameter is defined, the loader will return a hash
+keyed on the file names, as opposed to the usual list of single-key hashes.
+
+C<load_files()> also supports a 'force_plugins' parameter, whose value should be an
+arrayref of plugin names like C<Config::Any::INI>. 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<driver_args> 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 } );
+    Config::Any->load_stems( { stems => \@stems, flatten_to_hash => 1 } );
 
 C<load_stems()> attempts to load configuration from a list of files which it generates
 by combining the filename stems list passed in the C<stems> parameter with the 
@@ -101,62 +111,132 @@ parameters. Please read the C<load_files()> 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   = {};
-
-    for my $loader ( $class->plugins ) {
-        my %ext = map { $_ => 1 } $loader->extensions;
-        FILE:
-        for my $filename (@$files_ref) {
-            if (defined $use_ext) {
-                for my $e (keys %ext) {
-                    my ($fileext) = $filename =~ m{ \. $e \z }xms;
-                    next FILE unless exists $ext{$fileext};
-                }
+    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
+        ? map { eval "require $_;"; $_; } @{ $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 ) {
+            for ( $plugin->extensions ) {
+                $extension_lut{ $_ } ||= [];
+                push @{ $extension_lut{ $_ } }, $plugin;
+            }
+        }
+
+        $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};
+
+            if ( !$1 ) {
+                $filename =~ m{\.([^.]+)\z};
+                croak "There are no loaders available for .${1} files";
             }
 
-            my $config;
-                       eval {
-                               $config = $loader->load( $filename );
-                       };
-                       next if $EVAL_ERROR;
-            next if !$config;
-            $filter_cb->( $config ) if defined $filter_cb;
-            push @$final_configs, { $filename => $config };
+            @try_plugins = @{ $extension_lut{ $1 } };
+        }
+
+        # not using use_ext means we try all plugins anyway, so we'll
+        # ignore it for the "unsupported" error
+        my $supported = $use_ext_lut ? 0 : 1;
+        for my $loader ( @try_plugins ) {
+            next unless $loader->is_supported;
+            $supported = 1;
+            my @configs
+                = eval { $loader->load( $filename, $loader_args{ $loader } ); };
+
+            # fatal error if we used extension matching
+            croak "Error parsing $filename: $@" if $@ and $use_ext_lut;
+            next if $@ or !@configs;
+
+            # post-process config with a filter callback
+            if ( $args->{ filter } ) {
+                $args->{ filter }->( $_ ) for @configs;
+            }
+
+            push @results,
+                { $filename => @configs == 1 ? $configs[ 0 ] : \@configs };
+            last;
+        }
+
+        if ( !$supported ) {
+            croak
+                "Cannot load $filename: required support modules are not available.\nPlease install "
+                . join( " OR ", map { _support_error( $_ ) } @try_plugins );
         }
     }
-    $final_configs;
+
+    if ( defined $args->{ flatten_to_hash } ) {
+        my %flattened = map { %$_ } @results;
+        return \%flattened;
+    }
+
+    return \@results;
+}
+
+sub _support_error {
+    my $module = shift;
+    if ( $module->can( 'requires_all_of' ) ) {
+        return join( ' and ',
+            map { ref $_ ? join( ' ', @$_ ) : $_ } $module->requires_all_of );
+    }
+    if ( $module->can( 'requires_any_of' ) ) {
+        return 'one of '
+            . join( ' or ',
+            map { ref $_ ? join( ' ', @$_ ) : $_ } $module->requires_any_of );
+    }
 }
 
 =head2 finder( )
@@ -169,12 +249,13 @@ more information.
 =cut
 
 sub finder {
-    my $class = shift;
+    my $class  = shift;
     my $finder = Module::Pluggable::Object->new(
         search_path => [ __PACKAGE__ ],
+        except      => [ __PACKAGE__ . '::Base' ],
         require     => 1
     );
-    $finder;
+    return $finder;
 }
 
 =head2 plugins( )
@@ -186,7 +267,9 @@ found by L<Module::Pluggable::Object|Module::Pluggable::Object>.
 
 sub plugins {
     my $class = shift;
-    return $class->finder->plugins;
+
+    # filter out things that don't look like our plugins
+    return grep { $_->isa( 'Config::Any::Base' ) } $class->finder->plugins;
 }
 
 =head2 extensions( )
@@ -199,15 +282,16 @@ parameter to those methods.
 
 sub extensions {
     my $class = shift;
-    my @ext = map { $_->extensions } $class->plugins;
-       return wantarray ? @ext : [@ext];
+    my @ext
+        = map { $_->extensions } $class->plugins;
+    return wantarray ? @ext : \@ext;
 }
 
 =head1 DIAGNOSTICS
 
 =over
 
-=item C<no files specified> or C<no stems specified>
+=item C<No files specified!> or C<No stems specified!>
 
 The C<load_files()> and C<load_stems()> methods will issue this warning if
 called with an empty list of files/stems to load.
@@ -251,7 +335,7 @@ L<http://rt.cpan.org>.
 
 =head1 AUTHOR
 
-Joel Bernstein  C<< <rataxis@cpan.org> >>
+Joel Bernstein E<lt>rataxis@cpan.orgE<gt>
 
 =head1 CONTRIBUTORS
 
@@ -261,9 +345,12 @@ module by Brian Cassidy C<< <bricas@cpan.org> >>.
 
 With ideas and support from Matt S Trout C<< <mst@shadowcatsystems.co.uk> >>.
 
+Further enhancements suggested by Evan Kaufman C<< <evank@cpan.org> >>.
+
 =head1 LICENCE AND COPYRIGHT
 
 Copyright (c) 2006, Portugal Telecom C<< http://www.sapo.pt/ >>. All rights reserved.
+Portions copyright 2007, Joel Bernstein C<< <rataxis@cpan.org> >>.
 
 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See L<perlartistic>.
@@ -298,5 +385,4 @@ L<Catalyst::Plugin::ConfigLoader|Catalyst::Plugin::ConfigLoader>
 
 =cut
 
-1; # Magic true value required at end of module
-
+"Drink more beer";