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=bc54d4791d1aec796e7d33297f347c5270a20936;hp=c7580a25abc79fae6ace4573ca28ed966c9ad99c;hb=ef87b7dccb1f56d34b2914141cf105bb04b8de32;hpb=59a8045203653a6f6cbccc3c24eb3884fba40ddc diff --git a/lib/Config/Any.pm b/lib/Config/Any.pm index c7580a2..bc54d47 100644 --- a/lib/Config/Any.pm +++ b/lib/Config/Any.pm @@ -6,7 +6,7 @@ use Carp; use Module::Pluggable::Object (); use English qw(-no_match_vars); -our $VERSION = (qw$Rev: $)[-1]; +our $VERSION = '0.08'; =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.0.8 =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 @@ -50,7 +50,7 @@ configuration formats. =head2 load_files( ) - Config::Any->load_files({files => \@files]}); + Config::Any->load_files({files => \@files}); Config::Any->load_files({files => \@files, filter => \&filter}); Config::Any->load_files({files => \@files, use_ext => 1}); @@ -69,6 +69,18 @@ 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 { @@ -79,10 +91,10 @@ sub load_files { 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); + my %load_args = map { $_ => defined $args->{$_} ? $args->{$_} : undef } + qw(filter use_ext force_plugins driver_args); + $load_args{files} = [ grep { -f $_ } @{$args->{files}} ]; + return $class->_load(\%load_args); } =head2 load_stems( ) @@ -108,9 +120,18 @@ sub load_stems { return; } - my $filter_cb = delete $args->{filter}; - my $use_ext = delete $args->{use_ext}; - my $stems = $args->{stems}; + my %load_args = map { $_ => defined $args->{$_} ? $args->{$_} : undef } + qw(filter use_ext force_plugins driver_args); + + my $filenames = $class->_stems_to_files($args->{stems}); + $load_args{files} = [ grep { -f $_ } @{$filenames} ]; + return $class->_load(\%load_args); +} + +sub _stems_to_files { + my ($class, $stems) = @_; + return unless defined $stems; + my @files; STEM: for my $s (@$stems) { @@ -122,37 +143,64 @@ sub load_stems { last EXT; } } - return $class->_load(\@files, $filter_cb, $use_ext); + \@files; } +sub _maphash (@) { map { $_ => 1 } @_ } # sugar + # 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) = @_; + my ($class, $args) = @_; + my ($files_ref, $filter_cb, $use_ext, $force_plugins_ref) = + @{$args}{qw(files filter use_ext force_plugins)}; croak "_load requires a arrayref of file paths" unless defined $files_ref; + my %files = _maphash @$files_ref; + my %force_plugins = _maphash @$force_plugins_ref; + my $enforcing = keys %force_plugins ? 1 : 0; + my $final_configs = []; my $originally_loaded = {}; + # perform a separate file loop for each loader for my $loader ( $class->plugins ) { - my %ext = map { $_ => 1 } $loader->extensions; + next if $enforcing && not defined $force_plugins{$loader}; + last unless keys %files; + my %ext = _maphash $loader->extensions; + + my ($loader_class) = $loader =~ /::([^:]+)$/; + my $driver_args = $args->{driver_args}{$loader_class} || {}; + FILE: - for my $filename (@$files_ref) { - if (defined $use_ext) { + for my $filename (keys %files) { + # use file extension to decide whether this loader should try this file + # use_ext => 1 hits this block + if (defined $use_ext && !$enforcing) { + my $matched_ext = 0; + EXT: for my $e (keys %ext) { - my ($fileext) = $filename =~ m{ \. $e \z }xms; - next FILE unless exists $ext{$fileext}; + next EXT unless $filename =~ m{ \. $e \z }xms; + next FILE unless exists $ext{$e}; + $matched_ext = 1; } + + next FILE unless $matched_ext; } my $config; - eval { - $config = $loader->load( $filename ); - }; - next if $EVAL_ERROR; + eval { + $config = $loader->load( $filename, $driver_args ); + }; + + next if $EVAL_ERROR; # if it croaked or warned, we can't use it next if !$config; + delete $files{$filename}; + + # post-process config with a filter callback, if we got one $filter_cb->( $config ) if defined $filter_cb; + push @$final_configs, { $filename => $config }; } } @@ -200,7 +248,7 @@ 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 @@ -251,7 +299,7 @@ L. =head1 AUTHOR -Joel Bernstein C<< >> +Joel Bernstein Erataxis@cpan.orgE =head1 CONTRIBUTORS @@ -261,9 +309,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. @@ -298,5 +349,4 @@ L =cut -1; # Magic true value required at end of module - +"Drink more beer";