Config-Auto-0.44/000755 001751 001751 00000000000 12304467022 014362 5ustar00bingosbingos000000 000000 Config-Auto-0.44/t/000755 001751 001751 00000000000 12304467021 014624 5ustar00bingosbingos000000 000000 Config-Auto-0.44/README000644 001751 001751 00000005714 12143731336 015254 0ustar00bingosbingos000000 000000 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.44/Makefile.PL000644 001751 001751 00000004236 12143731336 016344 0ustar00bingosbingos000000 000000 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.44/lib/000755 001751 001751 00000000000 12304467021 015127 5ustar00bingosbingos000000 000000 Config-Auto-0.44/Changes000644 001751 001751 00000007306 12304466631 015670 0ustar00bingosbingos000000 000000 0.44 Sat Mar 1 23:26:12 GMT 2014 - Resolve RT#91891 an edge-case with equal and space format detection 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.44/MANIFEST000644 001751 001751 00000000740 12304467022 015514 0ustar00bingosbingos000000 000000 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/07_rt91891.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 t/src/07_rt91891.conf META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Config-Auto-0.44/META.yml000644 001751 001751 00000001250 12304467022 015631 0ustar00bingosbingos000000 000000 --- 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.9, CPAN::Meta::Converter version 2.133380' 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.44' Config-Auto-0.44/META.json000644 001751 001751 00000002250 12304467022 016002 0ustar00bingosbingos000000 000000 { "abstract" : "Magical config file parser", "author" : [ "Jos I. Boumans " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.9, CPAN::Meta::Converter version 2.133380", "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.44" } Config-Auto-0.44/lib/Config/000755 001751 001751 00000000000 12304467021 016334 5ustar00bingosbingos000000 000000 Config-Auto-0.44/lib/Config/Auto.pm000644 001751 001751 00000057262 12304466706 017627 0ustar00bingosbingos000000 000000 package Config::Auto; use strict; use warnings; use Carp qw[croak]; use vars qw[$VERSION $DisablePerl $Untaint $Debug]; $VERSION = '0.44'; $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+)/); } if ( $score{equal} && $score{space} && $score{equal} == $score{space} ) { $score{equal}++; } $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.44/t/06_const_it.t000644 001751 001751 00000000660 12143731336 017146 0ustar00bingosbingos000000 000000 #!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.44/t/07_rt91891.t000644 001751 001751 00000000656 12304466631 016375 0ustar00bingosbingos000000 000000 use strict; use warnings; use Config::Auto; use File::Spec; use Test::More 'no_plan'; BEGIN { chdir 't' if -d 't'; } my $expecting = { 'SOME_SETTING' => [ '/a/b/c ' ], }; my $ca = Config::Auto->new( source => File::Spec->catfile( 'src', '07_rt91891.conf' ), ); 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.44/t/02_parse.t000644 001751 001751 00000015261 12143731336 016435 0ustar00bingosbingos000000 000000 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 blocks http://www.example.com Tests & 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.44/t/04_magic.t000644 001751 001751 00000000710 12143731336 016376 0ustar00bingosbingos000000 000000 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.44/t/05_rt69984.t000644 001751 001751 00000001073 12143731336 016373 0ustar00bingosbingos000000 000000 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.44/t/src/000755 001751 001751 00000000000 12304467021 015413 5ustar00bingosbingos000000 000000 Config-Auto-0.44/t/99_pod.t000644 001751 001751 00000000217 12143731336 016120 0ustar00bingosbingos000000 000000 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.44/t/lib/000755 001751 001751 00000000000 12304467021 015372 5ustar00bingosbingos000000 000000 Config-Auto-0.44/t/00_load.t000644 001751 001751 00000000155 12143731336 016234 0ustar00bingosbingos000000 000000 use Test::More tests => 1; use_ok( 'Config::Auto' ); diag( "Testing Config::Auto $Config::Auto::VERSION" ); Config-Auto-0.44/t/20_XML_unvailable.t000644 001751 001751 00000000723 12143731336 020162 0ustar00bingosbingos000000 000000 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.44/t/fstab000644 001751 001751 00000000265 12143731336 015655 0ustar00bingosbingos000000 000000 /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.44/t/01_OO.t000644 001751 001751 00000002567 12143731336 015644 0ustar00bingosbingos000000 000000 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.44/t/03_invalid.t000644 001751 001751 00000001106 12143731336 016743 0ustar00bingosbingos000000 000000 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.44/t/lib/XML/000755 001751 001751 00000000000 12304467021 016032 5ustar00bingosbingos000000 000000 Config-Auto-0.44/t/lib/XML/Simple.pm000644 001751 001751 00000000056 12143731336 017626 0ustar00bingosbingos000000 000000 package XML::Simple; sub import { die }; 1; Config-Auto-0.44/t/src/05_rt69984.conf000644 001751 001751 00000000233 12143731336 017641 0ustar00bingosbingos000000 000000 # A list of defined backup jobs backup.jobs.list = production development infrastructure jaguararray foo = bar Config-Auto-0.44/t/src/07_rt91891.conf000644 001751 001751 00000000027 12304465355 017640 0ustar00bingosbingos000000 000000 SOME_SETTING="/a/b/c " Config-Auto-0.44/t/src/04_magic.config000644 001751 001751 00000000007 12143731336 020166 0ustar00bingosbingos000000 000000 # test