Config-Auto-0.42 0040755 0001751 0000144 00000000000 11714252710 0012527 5 ustar chris users Config-Auto-0.42/t 0040755 0001751 0000144 00000000000 11714252707 0013000 5 ustar chris users Config-Auto-0.42/t/04_magic.t 0100644 0001751 0000144 00000000710 11620035552 0014613 0 ustar chris users use strict;
use warnings;
use Test::More 'no_plan';
BEGIN { chdir 't' if -d 't'; }
my $Class = 'Config::Auto';
use_ok( $Class );
### find a config file based on $0
{ my $obj = $Class->new( path => ['src'] );
ok( $obj, "Object created" );
isa_ok( $obj, $Class, " Object" );
my $file = $obj->file;
ok( $file, " File found: $file" );
ok( -e $file, " File exists" );
}
Config-Auto-0.42/t/20_XML_unvailable.t 0100644 0001751 0000144 00000000723 11620035552 0016377 0 ustar chris users use strict;
use warnings;
use Test::More 'no_plan';
my $Class = 'Config::Auto';
### this includes a dummy XML::Simple that dies on import
use lib 't/lib';
use_ok( $Class );
{ my $obj = $Class->new( source => $$.$/, format => 'xml' );
ok( $obj, "Object created" );
eval { $obj->parse };
ok( $@, "parse() on xml dies without XML::Simple" );
like( $@, qr/XML::Simple/, " Error message is informative" );
}
Config-Auto-0.42/t/src 0040755 0001751 0000144 00000000000 11714252707 0013567 5 ustar chris users Config-Auto-0.42/t/src/05_rt69984.conf 0100644 0001751 0000144 00000000233 11620035371 0016055 0 ustar chris users # A list of defined backup jobs
backup.jobs.list = production development infrastructure jaguararray
foo = bar
Config-Auto-0.42/t/src/04_magic.config 0100644 0001751 0000144 00000000007 11554371735 0016417 0 ustar chris users # test
Config-Auto-0.42/t/00_load.t 0100644 0001751 0000144 00000000155 11554371735 0014465 0 ustar chris users use Test::More tests => 1;
use_ok( 'Config::Auto' );
diag( "Testing Config::Auto $Config::Auto::VERSION" );
Config-Auto-0.42/t/05_rt69984.t 0100644 0001751 0000144 00000001073 11620040053 0014600 0 ustar chris users use strict;
use warnings;
use Config::Auto;
use File::Spec;
use Test::More 'no_plan';
BEGIN { chdir 't' if -d 't'; }
my $expecting = {
'backup.jobs.list' => [
'production',
'development',
'infrastructure',
'jaguararray'
],
'foo' => 'bar'
};
my $ca = Config::Auto->new(
source => File::Spec->catfile( 'src', '05_rt69984.conf' ),
format => 'equal',
);
my $config = $ca->parse;
ok( $config, 'Got config' );
is( ref($config), 'HASH', 'Got hash' );
is_deeply( $config, $expecting, 'It looks like it should' );
Config-Auto-0.42/t/02_parse.t 0100644 0001751 0000144 00000015261 11620035552 0014652 0 ustar chris users use strict;
use warnings;
use Test::More 'no_plan';
use File::Temp 'tempfile';
my $Class = 'Config::Auto';
my $Verbose = @ARGV ? 1 : 0;
use_ok( $Class );
my $Func = $Class->can('parse');
my $Map = {
# format # key = text, value = expected result
colon => {
qq[
test: foo=bar
test: baz
quux: zoop
] => { test => { foo => 'bar', baz => 1 }, quux => 'zoop' },
qq[
# /etc/nsswitch.conf
#
# Example configuration of GNU Name Service Switch functionality.
# If you have the `glibc-doc' and `info' packages installed, try:
# `info libc "Name Service Switch"' for information about this file.
passwd: compat
group: compat
hosts: files dns
] => { passwd => 'compat', group => 'compat', hosts => [qw|files dns|] },
qq[
root:x:0:0:root:/root:/bin/bash
daemon:x:1:1:daemon:/usr/sbin:/bin/sh
bin:x:2:2:bin:/bin:/bin/sh
] => { root => [qw|x 0 0 root /root /bin/bash|],
daemon => [qw|x 1 1 daemon /usr/sbin /bin/sh |],
bin => [qw|x 2 2 bin /bin /bin/sh |],
},
},
equal => {
qq[
# This file was generated by debconf automaticaly.
# Please use dpkg-reconfigure to edit.
# And you can copy this file to ~/.mozillarc to override.
MOZILLA_DSP=auto
USE_GDKXFT=false
] => { MOZILLA_DSP => 'auto', USE_GDKXFT => 'false' },
},
space => {
qq[
set foo "bar, baby"
] => { set => ['foo', 'bar, baby'] },
qq[
search oucs.ox.ac.uk ox.ac.uk
nameserver 163.1.2.1
nameserver 129.67.1.1
nameserver 129.67.1.180
] => { search => [qw|oucs.ox.ac.uk ox.ac.uk|],
nameserver => [qw|163.1.2.1 129.67.1.1 129.67.1.180|],
},
},
xml => {
qq[
test blockshttp://www.example.comTests & Failures
] => { main => { title => 'test blocks',
url => 'http://www.example.com',
name => 'Tests & Failures' },
urlreader => { start => 'home.html' },
},
},
yaml => {
qq[
--- #YAML:1.0
test:
foo: bar
] => { test => { foo => 'bar' } },
},
ini => {
qq[
[group1]
host = proxy.some-domain-name.com
port = 80
username = blah
password = doubleblah
] => { group1 => { host => 'proxy.some-domain-name.com',
port => 80,
username => 'blah',
password => 'doubleblah' },
},
},
list => {
### don't leave an empty trailing newline, it'll create an
### empty entry
qq[
foo
+bar
-baz
] => [ qw|foo +bar -baz| ],
},
perl => {
q[
#!/usr/bin/perl
{ foo => [ $$, $$ ] };
] => { foo => [ $$, $$ ] },
},
};
### test parsing all formats
{ my %formats = map { $_ => $_ } $Class->formats;
### if we dont have xml support, don't try to test it.
my $skip_xml = eval { require XML::Simple; 1 } ? 0 : 1;
while( my($format,$href) = each %$Map ) { SKIP: {
ok( 1, "Testing '$format' configs" );
### we tested this one, remove it from the list
### if anything's left at the end, we failed at testing
delete $formats{$format} if $formats{$format};
# 3 = amount of formats, 9 = amount of individual tests
skip( "No XML::Simple installed", 3 * 9 * scalar(keys %$href) )
if $format eq 'xml' and $skip_xml;
while( my($text,$result) = each %$href ) {
### strip leading newline, we added it in the $Map for
### formatting purposes only.
$text =~ s/^\n//;
### first line to display in the test header
my ($header) = ($text =~ /^(.+?)\n/);
### 3 input mechanisms: text, fh and file
### create the latter 2 from the former
my($fh,$file) = tempfile();
### write the file
{ print $fh $text;
$fh->close;
### reopen the FH for reading this time
open $fh, $file or warn "Could not reopen $file: $!";
}
my %src = (
text => $text,
fh => $fh,
file => $file
);
while( my($desc, $src) = each %src ) {
ok( 1, " Passing '$desc' containing '$header'..." );
### using OO
{ ### reset position if we're using a FH
seek $src, 0, 0 if ref $src;
my $obj = $Class->new( source => $src );
diag( "About to parse:\n$text" ) if $Verbose;
ok( $obj, " Object created" );
my $rv = eval { $obj->parse };
ok( !$@, " No errors while parsing $@" );
ok( $obj->score," Scores assigned" );
is( $obj->format, $format,
" Right format detected" );
ok( $rv, " Text parsed" );
is_deeply( $rv, $result,
" Parsed correctly" );
}
### using functional layer
{ ### reset position if we're using a FH
seek $src, 0, 0 if ref $src;
my $rv = $Func->( $src );
ok( $rv, " Return value created from function call" );
is_deeply( $rv, $result,
" Parsed correctly" );
}
}
}
} }
{ ### TODO implementations, so remove them from the list:
for ( qw[bind irssi] ) {
ok( delete $formats{$_},
"No '$_' support yet" );
}
my @left = keys %formats;
ok( !scalar(@left), "All formats tested (@left)" );
}
}
### try parsing perl with perl parsing disabled
{ while( my($text,$expect) = each %{$Map->{'perl'}} ) {
ok( 1, "Testing DisablePerl = 1" );
### pesky warnings
local $Config::Auto::DisablePerl = 1;
local $Config::Auto::DisablePerl = 1;
### strip leading newline, we added it in the $Map for
### formatting purposes only.
$text =~ s/^\n//;
my $rv = eval { $Func->( $text ) };
ok(!$rv, " No return value" );
ok( $@, " Exception thrown" );
like( $@, qr/Unparsable file format/,
" No suitable parser found" );
}
}
Config-Auto-0.42/t/99_pod.t 0100644 0001751 0000144 00000000217 11554371735 0014351 0 ustar chris users use Test::More;
use strict;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
Config-Auto-0.42/t/03_invalid.t 0100644 0001751 0000144 00000001106 11620035552 0015160 0 ustar chris users use strict;
use warnings;
use Test::More 'no_plan';
my $Class = 'Config::Auto';
my $Method = 'score';
my $Data = <<'.';
[part one]
This: is garbage
.
use_ok( $Class );
{ my $obj = $Class->new( source => $Data );
ok( $obj, "Object created" );
isa_ok( $obj, $Class, " Object" );
{ my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= "@_" };
my $rv = $obj->$Method;
ok( scalar(keys %$rv), " Got return value from '$Method'" );
is( $warnings, '', " No warnings recorded" );
}
}
Config-Auto-0.42/t/06_const_it.t 0100644 0001751 0000144 00000000660 11714252301 0015360 0 ustar chris users #!perl
use Test::More 'no_plan';
use strict;
use Config::Auto;
my $test_file = 't/fstab'; # A file found on any Unix/Linux machine.
SKIP: {
skip "Can't test: $test_file doesn't exist on this system."
unless -e $test_file;
for ( 'bar' ) {
eval { Config::Auto::parse($test_file); };
ok( !$@,
'Config::Auto:parse() where $_ aliases a string literal.' );
diag($@) if $@;
}
}
Config-Auto-0.42/t/lib 0040755 0001751 0000144 00000000000 11714252707 0013546 5 ustar chris users Config-Auto-0.42/t/lib/XML 0040755 0001751 0000144 00000000000 11714252707 0014206 5 ustar chris users Config-Auto-0.42/t/lib/XML/Simple.pm 0100644 0001751 0000144 00000000056 11554371735 0016057 0 ustar chris users package XML::Simple;
sub import { die };
1;
Config-Auto-0.42/t/fstab 0100644 0001751 0000144 00000000265 11714252144 0014074 0 ustar chris users /dev/wd0a / ffs rw 1 1
/dev/wd0b none swap sw 0 0
/dev/wd0e /usr ffs rw 1 2
/dev/wd0f /var ffs rw 1 2
/dev/wd0g /home ffs rw 1 2
kernfs /kern kernfs rw
procfs /proc procfs rw,linux
Config-Auto-0.42/t/01_OO.t 0100644 0001751 0000144 00000002567 11620035552 0014061 0 ustar chris users use strict;
use warnings;
use Test::More 'no_plan';
my $Class = 'Config::Auto';
use_ok( $Class );
my @Formats = $Class->formats;
ok( scalar(@Formats), "Retrieved available formats" );
### try to create some objects using all formats
{ ok( 1, "Building object for every format" );
for my $format (@Formats) {
my $obj = $Class->new( source => $0, format => $format );
ok( $obj, " Built object from '$format'" );
isa_ok( $obj, $Class, " Object" );
is( $obj->format, $format,
" Format as expected" );
}
}
### grab one format, do all the accessor and sanity checks on it
{ ok( 1, "Testing data retrieval methods" );
my $obj = $Class->new( source => $0 );
ok( $obj, " Object created" );
isa_ok( $obj, $Class, " Object" );
isa_ok( $obj->data, 'ARRAY'," Data retrieved" );
ok( -e $obj->file, " Filename found" );
ok( ref( $obj->fh ), " Filehandle found" );
ok( $obj->as_string, " Contents retrieved" );
my $href = $obj->score;
ok( $href, " Score computed" );
isa_ok( $href, 'HASH', " Return value" );
ok( scalar(keys(%$href)), " Scores found" );
}
Config-Auto-0.42/Changes 0100644 0001751 0000144 00000010625 11714252650 0014105 0 ustar chris users 0.42 Tue Feb 7 16:46:38 GMT 2012
===================================
- Add a test fstab file instead of relying on the vagaries of system ones
0.40 Mon Feb 6 21:19:29 2012
================================
- Resolve RT 74711 reported by David Oswald
( Calling Config::Auto::parse while $_ aliases a constant value throws exception )
0.38 Mon Aug 8 21:38:10 2011
================================
- Resolve RT 69984 reported by Thomas Johnson
( Array handling regression when using equals format )
0.36 Fri Jul 1 14:38:57 2011
================================
- Fix for RT 68913 reported by Michael Lackhoff
( config files with DOS line endings do not work in Linux )
0.34 Tue Mar 8 15:02:06 2011
================================
- Apply patch from Andrew Ruthven RT #66460
( also Debian Bug # 617305 )
0.32 Wed Feb 23 21:25:09 2011
================================
- Fix a regression with space separated format
reported by Karel Petera RT #66050
0.30 Sun Jan 23 22:51:22 2011
================================
- Apply a fix from Nigel Horne RT #65019
0.29_02 Thu Mar 12 12:39:03 2009
================================
- Not all versions of XML::Parser deal well with an IO::String filehandle;
pass the value in as string instead
- Fix a broken XML test
- Remove stray $DB::single = 1
- Don't delete XML tests, skip them
0.29_01 Wed Mar 11 13:51:31 2009
================================
- Address #44018: Speed enhancements to only load modules if they are
actually needed. By Lyle Hopkins
- Address #32927: Hash key being assigned to $1 instead of $_
- Address #28608: Quoted parameters in Config::Auto
parsing now properly splits on quoted words, shell like
- Address #27686: an odd config format could throw uninitialized
value warnings
- Guts of Config::Auto rewritten to allow access to data in various
stages.
- Updates prereq list
- Increased test coverage
0.20 Sat Apr 7 15:13:51 2007
================================
- Address #25732: Close filehandles after parsing
Config::Auto wasn't closing it's filehandles after
reading from them. Now it does.
0.18 Wed Jun 28 12:22:29 2006
================================
- Address #19938 which states that calling parse()
on an xml config without XML::Simple installed
dies ungracefully. As of this version, better
diagnostics will be provided.
0.17 Tue May 2 14:41:18 2006
================================
- Improved YAML autodetection [#18241]
0.15_01 Thu Aug 11 17:00:50 2005
================================
- Added experimental YAML support
0.14 Thu Aug 11 16:27:50 2005
================================
- Fix uninitialized value warning
- Fix pod error
- Files under /etc we're not properly detected
- Fix casing of 'perl' in the Formats section of the pod
- Make formats be accepted in any casing
0.13 Tue Jul 26 16:35:37 2005
================================
- Add optional path support
- update test suite to test::more
- split tests by different formats
- Patch supplied by ssoriche@coloredblocks.net, tweaked and applied
0.12 Thu Mar 10 14:58:06 2005
================================
- extend do() diagnostics for perl files
- extend documentation
0.11 Wed Nov 10 11:35:41 2004
================================
- fix small thinko in file finding logic.
0.10 Tue Aug 17 14:34:41 2004
================================
- added support for fixed config file name.
0.07 ???
===================================
- added support for '/usr/local/etc/'
0.06 Sat Feb 21 13:21:43 2004
===================================
- fix a bug in tr/// on a string
0.05 Tue Feb 10 13:16:59 2004
===================================
- Fix so that a config file is magically found when the program
is started with a full pathname as well
0.04 Sun Sep 7 19:28:40 2003
====================================
- Jos Boumans took maintainership
- XML::Simple is now an optional module
0.03 Sun Aug 4 09:51:42 2002
====================================
- INI files patch by Garrett Rooney
0.02 Thu Jul 4 17:20:13 2002
====================================
- I always screw up the README.
====================================
0.01 Wed Jul 3 15:00:16 2002
- original version; created by h2xs 1.21 with options
-AX -n Config::Auto
Config-Auto-0.42/MANIFEST 0100644 0001751 0000144 00000000673 11714252710 0013742 0 ustar chris users Changes
lib/Config/Auto.pm
Makefile.PL
MANIFEST This list of files
README
t/00_load.t
t/01_OO.t
t/02_parse.t
t/03_invalid.t
t/04_magic.t
t/05_rt69984.t
t/06_const_it.t
t/20_XML_unvailable.t
t/99_pod.t
t/fstab
t/lib/XML/Simple.pm
t/src/04_magic.config
t/src/05_rt69984.conf
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
Config-Auto-0.42/lib 0040755 0001751 0000144 00000000000 11714252707 0013303 5 ustar chris users Config-Auto-0.42/lib/Config 0040755 0001751 0000144 00000000000 11714252707 0014510 5 ustar chris users Config-Auto-0.42/lib/Config/Auto.pm 0100644 0001751 0000144 00000057106 11714252357 0016044 0 ustar chris users package Config::Auto;
use strict;
use warnings;
use Carp qw[croak];
use vars qw[$VERSION $DisablePerl $Untaint $Debug];
$VERSION = '0.42';
$DisablePerl = 0;
$Untaint = 0;
$Debug = 0;
=head1 NAME
Config::Auto - Magical config file parser
=head1 SYNOPSIS
use Config::Auto;
### Not very magical at all.
$config = Config::Auto::parse("myprogram.conf", format => "colon");
### Considerably more magical.
$config = Config::Auto::parse("myprogram.conf");
### Highly magical.
$config = Config::Auto::parse();
### Using the OO interface
$ca = Config::Auto->new( source => $text );
$ca = Config::Auto->new( source => $fh );
$ca = Config::Auto->new( source => $filename );
$href = $ca->score; # compute the score for various formats
$config = $ca->parse; # parse the config
$format = $ca->format; # detected (or provided) config format
$str = $ca->as_string; # config file stringified
$fh = $ca->fh; # config file handle
$file = $ca->file; # config filename
$aref = $ca->data; # data from your config, split by newlines
=cut
=head1 DESCRIPTION
This module was written after having to write Yet Another Config File Parser
for some variety of colon-separated config. I decided "never again".
Config::Auto aims to be the most C config parser available, by detecting
configuration styles, include paths and even config filenames automagically.
See the L section below on implementation details.
=cut
=head1 ACCESSORS
=head2 @formats = Config::Auto->formats
Returns a list of supported formats for your config files. These formats
are also the keys as used by the C method.
C recognizes the following formats:
=over 4
=item * perl => perl code
=item * colon => colon separated (e.g., key:value)
=item * space => space separated (e.g., key value)
=item * equal => equal separated (e.g., key=value)
=item * bind => bind style (not available)
=item * irssi => irssi style (not available)
=item * xml => xml (via XML::Simple)
=item * ini => .ini format (via Config::IniFiles)
=item * list => list (e.g., foo bar baz)
=item * yaml => yaml (via YAML.pm)
=back
=cut
my %Methods = (
perl => \&_eval_perl,
colon => \&_colon_sep,
space => \&_space_sep,
equal => \&_equal_sep,
bind => \&_bind_style,
irssi => \&_irssi_style,
ini => \&_parse_ini,
list => \&_return_list,
yaml => \&_yaml,
xml => \&_parse_xml,
);
sub formats { return keys %Methods }
=head1 METHODS
=head2 $obj = Config::Auto->new( [source => $text|$fh|$filename, path => \@paths, format => FORMAT_NAME] );
Returns a C object based on your configs source. This can either be:
=over 4
=item a filehandle
Any opened filehandle, or C/C object.
=item a plain text string
Any plain string containing one or more newlines.
=item a filename
Any plain string pointing to a file on disk
=item nothing
A heuristic will be applied to find your config file, based on the name of
your script; C<$0>.
=back
Although C is at its most magical when called with no parameters,
its behavior can be controlled explicitly by using one or two arguments.
If a filename is passed as the C argument, the same paths are checked,
but C will look for a file with the passed name instead of the
C<$0>-based names.
Supplying the C parameter will add additional directories to the search
paths. The current directory is searched first, then the paths specified with
the path parameter. C can either be a scalar or a reference to an array
of paths to check.
The C parameters forces C to interpret the contents of
the configuration file in the given format without trying to guess.
=cut
### generate accessors
{ no strict 'refs';
for my $meth ( qw[format path source _fh _data _file _score _tmp_fh] ) {
*$meth = sub {
my $self = shift;
$self->{$meth} = shift if @_;
return $self->{$meth};
};
}
}
sub new {
my $class = shift;
my %hash = @_;
my $self = bless {}, $class;
if( my $format = $hash{'format'} ) {
### invalid format
croak "No such format '$format'" unless $Methods{$format};
$self->format( $format );
}
### set the other values that could be passed
for my $key ( qw[source path] ) {
$self->$key( defined $hash{$key} ? $hash{$key} : '' );
}
return $self;
}
=head2 $rv = $obj->parse | Config::Auto::parse( [$text|$fh|$filename, path => \@paths, format => FORMAT_NAME] );
Parses the source you provided in the C call and returns a data
structure representing your configuration file.
You can also call it in a procedural context (C), where
the first argument is the source, and the following arguments are named. This
function is provided for backwards compatiblity with releases prior to 0.29.
=cut
sub parse {
my $self = shift;
### XXX todo: re-implement magic configuration file finding based on $0
### procedural invocation, fix to OO
unless( UNIVERSAL::isa( $self, __PACKAGE__ ) ) {
$self = __PACKAGE__->new( source => $self, @_ )
or croak( "Could not parse '$self' => @_" );
}
my $file = $self->file;
croak "No config file found!" unless defined $file;
croak "Config file $file not readable!" unless -e $file;
### from Toru Marumoto: Config-Auto return undef if -B $file
### <21d48be50604271656n153e6db6m9b059f57548aaa32@mail.gmail.com>
# If a config file "$file" contains multibyte charactors like japanese,
# -B returns "true" in old version of perl such as 5.005_003. It seems
# there is no problem in perl 5.6x or newer.
### so check -B and only return only if
unless( $self->format ) {
return if $self->file and -B $self->file and $] >= '5.006';
my $score = $self->score;
### no perl?
delete $score->{perl} if exists $score->{perl} and $DisablePerl;
### no formats found
croak "Unparsable file format!" unless keys %$score;
### Clear winner?
{ my @methods = sort { $score->{$b} <=> $score->{$a} } keys %$score;
if (@methods > 1) {
croak "File format unclear! " .
join ",", map { "$_ => $score->{$_}"} @methods
if $score->{ $methods[0] } == $score->{ $methods[1] };
}
$self->format( $methods[0] );
$self->_debug( "Using the following format for parsing: " . $self->format );
}
}
return $Methods{ $self->format }->($self);
}
=head2 $href = $obj->score;
Takes a look at the contents of your configuration data and produces a
'score' determining which format it most likely contains.
They keys are equal to formats as returned by the C<< Config::Auto->formats >>
and their values are a score between 1 and 100. The format with the highest
score will be used to parse your configuration data, unless you provided the
C option explicitly to the C method.
=cut
sub score {
my $self = shift;
return $self->_score if $self->_score;
my $data = $self->data;
return { xml => 100 } if $data->[0] =~ /^\s*<\?xml/;
return { perl => 100 } if $data->[0] =~ /^#!.*perl/;
my %score;
for (@$data) {
### it's almost definately YAML if the first line matches this
$score{yaml} += 20 if /(?:\#|%) # a #YAML or %YAML
YAML
(?::|\s) # a YAML: or YAML[space]
/x and $data->[0] eq $_;
$score{yaml} += 20 if /^---/ and $data->[0] eq $_;
$score{yaml} += 10 if /^\s+-\s\w+:\s\w+/;
# Easy to comment out foo=bar syntax
$score{equal}++ if /^\s*#\s*\w+\s*=/;
next if /^\s*#/;
$score{xml}++ for /(<\w+.*?>)/g;
$score{xml}+= 2 for m|()|g;
$score{xml}+= 5 for m|(/>)|g;
next unless /\S/;
$score{equal}++, $score{ini}++ if m|^.*=.*$|;
$score{equal}++, $score{ini}++ if m|^\S+\s+=\s+|;
$score{colon}++ if /^[^:]+:[^:=]+/;
$score{colon}+=2 if /^\s*\w+\s*:[^:]+$/;
$score{colonequal}+= 3 if /^\s*\w+\s*:=[^:]+$/; # Debian foo.
$score{perl}+= 10 if /^\s*\$\w+(\{.*?\})*\s*=.*/;
$score{space}++ if m|^[^\s:]+\s+\S+$|;
# mtab, fstab, etc.
$score{space}++ if m|^(\S+)\s+(\S+\s*)+|;
$score{bind}+= 5 if /\s*\S+\s*{$/;
$score{list}++ if /^[\w\/\-\+]+$/;
$score{bind}+= 5 if /^\s*}\s*$/ and exists $score{bind};
$score{irssi}+= 5 if /^\s*};\s*$/ and exists $score{irssi};
$score{irssi}+= 10 if /(\s*|^)\w+\s*=\s*{/;
$score{perl}++ if /\b([@%\$]\w+)/g;
$score{perl}+= 2 if /;\s*$/;
$score{perl}+=10 if /(if|for|while|until|unless)\s*\(/;
$score{perl}++ for /([\{\}])/g;
$score{equal}++, $score{ini}++ if m|^\s*\w+\s*=.*$|;
$score{ini} += 10 if /^\s*\[[\s\w]+\]\s*$/;
}
# Choose between Win INI format and foo = bar
if (exists $score{ini}) {
no warnings 'uninitialized';
$score{ini} > $score{equal}
? delete $score{equal}
: delete $score{ini};
}
# Some general sanity checks
if (exists $score{perl}) {
$score{perl} /= 2 unless ("@$data" =~ /;/) > 3 or $#$data < 3;
delete $score{perl} unless ("@$data" =~ /;/);
delete $score{perl} unless ("@$data" =~ /([\$\@\%]\w+)/);
}
$self->_score( \%score );
return \%score;
}
=head2 $aref = $obj->data;
Returns an array ref of your configuration data, split by newlines.
=cut
sub data {
my $self = shift;
return $self->_data if $self->_data;
my $src = $self->source;
### filehandle
if( ref $src ) {
my @data = <$src>;
$self->_data( \@data );
seek $src, 0, 0; # reset position!
### data
} elsif ( $src =~ /\n/ ) {
$self->_data( [ split $/, $src, -1 ] );
### filename
} else {
my $fh = $self->fh;
my @data = <$fh>;
$self->_data( \@data );
seek $fh, 0, 0; # reset position!
}
return $self->_data;
}
=head2 $fh = $obj->fh;
Returns a filehandle, opened for reading, containing your configuration
data. This works even if you provided a plain text string or filename to
parse.
=cut
sub fh {
my $self = shift;
return $self->_fh if $self->_fh;
my $src = $self->source;
### filehandle
if( ref $src ) {
$self->_fh( $src );
### data
} elsif ( $src =~ /\n/ ) {
require IO::String;
my $fh = IO::String->new;
print $fh $src;
$fh->setpos(0);
$self->_fh( $fh );
} else {
my $fh;
my $file = $self->file;
if( open $fh, $file ) {
$self->_fh( $fh );
} else {
$self->_debug( "Could not open '$file': $!" );
return;
}
}
return $self->_fh;
}
=head2 $filename = $obj->file;
Returns a filename containing your configuration data. This works even
if you provided a plaintext string or filehandle to parse. In that case,
a temporary file will be written holding your configuration data.
=cut
sub file {
my $self = shift;
return $self->_file if $self->_file;
my $src = $self->source;
### filehandle or datastream, no file attached =/
### so write a temp file
if( ref $src or $src =~ /\n/ ) {
### require only when needed
require File::Temp;
my $tmp = File::Temp->new;
$tmp->print( ref $src ? <$src> : $src );
$tmp->close; # write to disk
$self->_tmp_fh( $tmp ); # so it won't get destroyed
$self->_file( $tmp->filename );
seek $src, 0, 0 if ref $src; # reset position!
} else {
my $file = $self->_find_file( $src, $self->path ) or return;
$self->_file( $file );
}
return $self->_file;
}
=head2 $str = $obj->as_string;
Returns a string representation of your configuration data.
=cut
sub as_string {
my $self = shift;
my $data = $self->data;
return join $/, @$data;
}
sub _find_file {
my ($self, $file, $path) = @_;
### moved here so they are only loaded when looking for a file
### all to keep memory usage down.
{ require File::Spec::Functions;
File::Spec::Functions->import('catfile');
require File::Basename;
File::Basename->import(qw[dirname basename]);
}
my $bindir = dirname($0);
my $whoami = basename($0);
$whoami =~ s/\.(pl|t)$//;
my @filenames = $file ||
("${whoami}config", "${whoami}.config",
"${whoami}rc", ".${whoami}rc");
my $try;
for my $name (@filenames) {
return $name if -e $name;
return $try if ( $try = $self->_chkpaths($path, $name) ) and -e $try;
return $try if -e ( $try = catfile($bindir, $name) );
return $try if $ENV{HOME} && -e ( $try = catfile($ENV{HOME}, $name) );
return "/etc/$name" if -e "/etc/$name";
return "/usr/local/etc/$name"
if -e "/usr/local/etc/$name";
}
$self->_debug( "Could not find file for '". $self->source ."'" );
return;
}
sub _chkpaths {
my ($self, $paths, $filename) = @_;
### no paths? no point in checking
return unless defined $paths;
my $file;
for my $path ( ref($paths) eq 'ARRAY' ? @$paths : $paths ) {
return $file if -e ($file = catfile($path, $filename));
}
return;
}
sub _eval_perl {
my $self = shift;
my $str = $self->as_string;
($str) = $str =~ m/^(.*)$/s if $Untaint;
my $cfg = eval "$str";
croak __PACKAGE__ . " couldn't parse perl data: $@" if $@;
return $cfg;
}
sub _parse_xml {
my $self = shift;
### Check if XML::Simple is already loaded
unless ( exists $INC{'XML/Simple.pm'} ) {
### make sure we give good diagnostics when XML::Simple is not
### available, but required to parse a config
eval { require XML::Simple; XML::Simple->import; 1 };
croak "XML::Simple not available. Can not parse " .
$self->as_string . "\nError: $@\n" if $@;
}
return XML::Simple::XMLin( $self->as_string );
}
sub _parse_ini {
my $self = shift;
### Check if Config::IniFiles is already loaded
unless ( exists $INC{'Config/IniFiles.pm'} ) {
### make sure we give good diagnostics when XML::Simple is not
### available, but required to parse a config
eval { require Config::IniFiles; Config::IniFiles->import; 1 };
croak "Config::IniFiles not available. Can not parse " .
$self->as_string . "\nError: $@\n" if $@;
}
tie my %ini, 'Config::IniFiles', ( -file => $self->file );
return \%ini;
}
sub _return_list {
my $self = shift;
### there shouldn't be any trailing newlines or empty entries here
return [ grep { length } map { chomp; $_ } @{ $self->data } ];
}
### Changed to YAML::Any which selects the fastest YAML parser available
### (req YAML 0.67)
sub _yaml {
my $self = shift;
require YAML::Any;
return YAML::Any::Load( $self->as_string );
}
sub _bind_style { croak "BIND8-style config not supported in this release" }
sub _irssi_style { croak "irssi-style config not supported in this release" }
# BUG: These functions are too similar. How can they be unified?
sub _colon_sep {
my $self = shift;
my $fh = $self->fh;
my %config;
local $_;
while (<$fh>) {
next if /^\s*#/;
/^\s*(.*?)\s*:\s*(.*)/ or next;
my ($k, $v) = ($1, $2);
my @v;
if ($v =~ /:/) {
@v = split /:/, $v;
} elsif ($v =~ /, /) {
@v = split /\s*,\s*/, $v;
} elsif ($v =~ / /) {
@v = split /\s+/, $v;
} elsif ($v =~ /,/) { # Order is important
@v = split /\s*,\s*/, $v;
} else {
@v = $v;
}
$self->_check_hash_and_assign(\%config, $k, @v);
}
return \%config;
}
sub _check_hash_and_assign {
my $self = shift;
my ($c, $k, @v) = @_;
if (exists $c->{$k} and !ref $c->{$k}) {
$c->{$k} = [$c->{$k}];
}
if (grep /=/, @v) { # Bugger, it's really a hash
for (@v) {
my ($subkey, $subvalue);
### If the array element has an equal sign in it...
if (/(.*)=(.*)/) {
($subkey, $subvalue) = ($1,$2);
###...otherwise, if the array element does not contain an equals sign:
} else {
$subkey = $_;
$subvalue = 1;
}
if (exists $c->{$k} and ref $c->{$k} ne "HASH") {
# Can we find a hash in here?
my $h=undef;
for (@{$c->{$k}}) {
last if ref ($h = $_) eq "hash";
}
if ($h) { $h->{$subkey} = $subvalue; }
else { push @{$c->{$k}}, { $subkey => $subvalue } }
} else {
$c->{$k}{$subkey} = $subvalue;
}
}
} elsif (@v == 1) {
if (exists $c->{$k}) {
if (ref $c->{$k} eq "HASH") { $c->{$k}{$v[0]} = 1; }
else {push @{$c->{$k}}, @v}
} else { $c->{$k} = $v[0]; }
} else {
if (exists $c->{$k}) {
if (ref $c->{$k} eq "HASH") { $c->{$k}{$_} = 1 for @v }
else {push @{$c->{$k}}, @v }
}
else { $c->{$k} = [@v]; }
}
}
{ ### only load Text::ParseWords once;
my $loaded_tp;
sub _equal_sep {
my $self = shift;
my $fh = $self->fh;
my %config;
local $_;
while ( <$fh>) {
next if /^\s*#/;
next unless /^\s*(.*?)\s*=\s*(.*?)\s*$/;
my ($k, $v) = ($1, $2);
### multiple enries, but no shell tokens?
if ($v=~ /,/ and $v !~ /(["']).*?,.*?\1/) {
$config{$k} = [ split /\s*,\s*/, $v ];
} elsif ($v =~ /\s/) { # XXX: Foo = "Bar baz"
### only load once
require Text::ParseWords unless $loaded_tp++;
$config{$k} = [ Text::ParseWords::shellwords($v) ];
} else {
$config{$k} = $v;
}
}
return \%config;
}
sub _space_sep {
my $self = shift;
my $fh = $self->fh;
my %config;
local $_;
while (<$fh>) {
next if /^\s*#/;
next unless /\s*(\S+)\s+(.*)/;
my ($k, $v) = ($1, $2);
my @v;
### multiple enries, but no shell tokens?
if ($v=~ /,/ and $v !~ /(["']).*?,.*?\1/) {
@v = split /\s*,\s*/, $v;
} elsif ($v =~ /\s/) { # XXX: Foo = "Bar baz"
### only load once
require Text::ParseWords unless $loaded_tp++;
@v = Text::ParseWords::shellwords($v);
} else {
@v = $v;
}
$self->_check_hash_and_assign(\%config, $k, @v);
}
return \%config;
}
}
sub _debug {
my $self = shift;
my $msg = shift or return;
Carp::confess( __PACKAGE__ . $msg ) if $Debug;
}
1;
__END__
=head1 GLOBAL VARIABLES
=head3 $DisablePerl
Set this variable to true if you do not wish to C perl style configuration
files.
Default is C
=head3 $Untaint
Set this variable to true if you automatically want to untaint values obtained
from a perl style configuration. See L for details on tainting.
Default is C
=head3 $Debug
Set this variable to true to get extra debug information from C
when finding and/or parsing config files fails.
Default is C
=head1 HOW IT WORKS
When you call C<< Config::Auto->new >> or C with no
arguments, we first look at C<$0> to determine the program's name. Let's
assume that's C. We look for the following files:
snerkconfig
~/snerkconfig
/etc/snerkconfig
/usr/local/etc/snerkconfig
snerk.config
~/snerk.config
/etc/snerk.config
/usr/local/etc/snerk.config
snerkrc
~/snerkrc
/etc/snerkrc
/usr/local/etc/snerkrc
.snerkrc
~/.snerkrc
/etc/.snerkrc
/usr/local/etc/.snerkrc
Additional search paths can be specified with the C option.
We take the first one we find, and examine it to determine what format
it's in. The algorithm used is a heuristic "which is a fancy way of
saying that it doesn't work." (Mark Dominus.) We know about colon
separated, space separated, equals separated, XML, Perl code, Windows
INI, BIND9 and irssi style config files. If it chooses the wrong one,
you can force it with the C option.
If you don't want it ever to detect and execute config files which are made
up of Perl code, set C<$Config::Auto::DisablePerl = 1>.
When using the perl format, your configuration file will be eval'd. This will
cause taint errors. To avoid these warnings, set C<$Config::Auto::Untaint = 1>.
This setting will not untaint the data in your configuration file and should only
be used if you trust the source of the filename.
Then the file is parsed and a data structure is returned. Since we're
working magic, we have to do the best we can under the circumstances -
"You rush a miracle man, you get rotten miracles." (Miracle Max) So
there are no guarantees about the structure that's returned. If you have
a fairly regular config file format, you'll get a regular data
structure back. If your config file is confusing, so will the return
structure be. Isn't life tragic?
=head1 EXAMPLES
Here's what we make of some common Unix config files:
F:
$VAR1 = {
'nameserver' => [ '163.1.2.1', '129.67.1.1', '129.67.1.180' ],
'search' => [ 'oucs.ox.ac.uk', 'ox.ac.uk' ]
};
F:
$VAR1 = {
'root' => [ 'x', '0', '0', 'root', '/root', '/bin/bash' ],
...
};
F:
$VAR1 = {
'append' => '""',
'responsiveness' => '',
'device' => '/dev/psaux',
'type' => 'ps2',
'repeat_type' => 'ms3'
};
F:
$VAR1 = {
'netgroup' => 'nis',
'passwd' => 'compat',
'hosts' => [ 'files', 'dns' ],
...
};
=cut
=head1 MEMORY USAGE
This module is as light as possible on memory, only using modules when they
are absolutely needed for configuration file parsing.
=head1 TROUBLESHOOTING
=over 4
=item When using a Perl config file, the configuration is borked
Give C more hints (e.g., add #!/usr/bin/perl to beginning of
file) or indicate the format in the C/C command.
=back
=head1 TODO
BIND9 and irssi file format parsers currently don't exist. It would be
good to add support for C and C style C-based RCs.
=head1 BUG REPORTS
Please report bugs or other issues to Ebug-config-auto@rt.cpan.orgE.
=head1 AUTHOR
Versions 0.04 and higher of this module by Jos Boumans Ekane@cpan.orgE.
This module originally by Simon Cozens.
=head1 COPYRIGHT
This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut
Config-Auto-0.42/README 0100644 0001751 0000144 00000005714 11554371735 0013505 0 ustar chris users NAME
Config::Auto - Magical config file parser
SYNOPSIS
use Config::Auto;
# Not very magical at all.
my $config = Config::Auto::parse("myprogram.conf", format => "colon");
# Considerably more magical.
my $config = Config::Auto::parse("myprogram.conf");
# Highly magical.
my $config = Config::Auto::parse();
DESCRIPTION
This module was written after having to write Yet Another Config File
Parser for some variety of colon-separated config. I decided "never
again".
When you call "Config::Auto::parse" with no arguments, we first look at
$0 to determine the program's name. Let's assume that's "snerk". We look
for the following files:
snerkconfig
~/snerkconfig
/etc/snerkconfig
snerk.config
~/snerk.config
/etc/snerk.config
snerkrc
~/snerkrc
/etc/snerkrc
.snerkrc
~/.snerkrc
/etc/.snerkrc
We take the first one we find, and examine it to determine what format
it's in. The algorithm used is a heuristic "which is a fancy way of
saying that it doesn't work." (Mark Dominus.) We know about colon
separated, space separated, equals separated, XML, Perl code, Windows
INI, BIND9 and irssi style config files. If it chooses the wrong one,
you can force it with the "format" option.
If you don't want it ever to detect and execute config files which are
made up of Perl code, set "$Config::Auto::DisablePerl = 1".
Then the file is parsed and a data structure is returned. Since we're
working magic, we have to do the best we can under the circumstances -
"You rush a miracle man, you get rotten miracles." (Miracle Max) So
there are no guarantees about the structure that's returned. If you have
a fairly regular config file format, you'll get a regular data structure
back. If your config file is confusing, so will the return structure be.
Isn't life tragic?
Here's what we make of some common Unix config files:
/etc/resolv.conf:
$VAR1 = {
'nameserver' => [ '163.1.2.1', '129.67.1.1', '129.67.1.180' ],
'search' => [ 'oucs.ox.ac.uk', 'ox.ac.uk' ]
};
/etc/passwd:
$VAR1 = {
'root' => [ 'x', '0', '0', 'root', '/root', '/bin/bash' ],
...
};
/etc/gpm.conf:
$VAR1 = {
'append' => '""',
'responsiveness' => '',
'device' => '/dev/psaux',
'type' => 'ps2',
'repeat_type' => 'ms3'
};
/etc/nsswitch.conf:
$VAR1 = {
'netgroup' => 'nis',
'passwd' => 'compat',
'hosts' => [ 'files', 'dns' ],
...
};
TODO
BIND9 and irssi file format parsers currently don't exist. It would be
good to add support for "mutt" and "vim" style "set"-based RCs.
AUTHOR
Simon Cozens, "simon@cpan.org"
LICENSE
AL&GPL.
Config-Auto-0.42/Makefile.PL 0100644 0001751 0000144 00000004236 11714252242 0014562 0 ustar chris users use ExtUtils::MakeMaker;
use strict;
use Getopt::Std;
my $opts = {};
getopts( 'x', $opts );
my $have_xml_simple = eval { require XML::Simple; 1; };
if( !$have_xml_simple and !$opts->{'x'} ) {
warn qq[Since the 0.04 release, XML::Simple is an optional prerequisite.\n].
qq[If you'd like to install Config::Auto with XML support, please\n] .
qq[rerun this Makefile.PL with the '-x' option\n];
}
my $prereqs = {
'XML::Simple' => 0,
'YAML' => 0.67,
'Config::IniFiles' => 0,
'File::Spec::Functions' => 0,
'Test::More' => 0,
'Text::ParseWords' => 0,
'File::Temp' => 0,
'IO::String' => 0,
};
delete $prereqs->{'XML::Simple'} unless $opts->{'x'};
WriteMakefile1(
LICENSE => 'perl',
META_MERGE => {
resources => {
repository => 'https://github.com/jib/config-auto',
},
},
'NAME' => 'Config::Auto',
'VERSION_FROM' => 'lib/Config/Auto.pm', # finds $VERSION
'PREREQ_PM' => $prereqs,
ABSTRACT_FROM => 'lib/Config/Auto.pm',
AUTHOR => 'Jos I. Boumans ',
);
sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
my %params=@_;
my $eumm_version=$ExtUtils::MakeMaker::VERSION;
$eumm_version=eval $eumm_version;
die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
die "License not specified" if not exists $params{LICENSE};
if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
#EUMM 6.5502 has problems with BUILD_REQUIRES
$params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
delete $params{BUILD_REQUIRES};
}
delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
delete $params{META_MERGE} if $eumm_version < 6.46;
delete $params{META_ADD} if $eumm_version < 6.46;
delete $params{LICENSE} if $eumm_version < 6.31;
delete $params{AUTHOR} if $] < 5.005;
delete $params{ABSTRACT_FROM} if $] < 5.005;
delete $params{BINARY_LOCATION} if $] < 5.005;
WriteMakefile(%params);
}
Config-Auto-0.42/META.yml 0100644 0001751 0000144 00000001223 11714252707 0014060 0 ustar chris users ---
abstract: 'Magical config file parser'
author:
- 'Jos I. Boumans '
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120351'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Config-Auto
no_index:
directory:
- t
- inc
requires:
Config::IniFiles: 0
File::Spec::Functions: 0
File::Temp: 0
IO::String: 0
Test::More: 0
Text::ParseWords: 0
YAML: 0.67
resources:
repository: https://github.com/jib/config-auto
version: 0.42
Config-Auto-0.42/META.json 0100644 0001751 0000144 00000002251 11714252710 0014224 0 ustar chris users {
"abstract" : "Magical config file parser",
"author" : [
"Jos I. Boumans "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120351",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Config-Auto",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Config::IniFiles" : "0",
"File::Spec::Functions" : "0",
"File::Temp" : "0",
"IO::String" : "0",
"Test::More" : "0",
"Text::ParseWords" : "0",
"YAML" : "0.67"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "https://github.com/jib/config-auto"
}
},
"version" : "0.42"
}