r1653 - in packages/libconfig-auto-perl/trunk: . debian lib/Config t
Niko Tyni
ntyni-guest at costa.debian.org
Fri Dec 16 21:35:41 UTC 2005
Author: ntyni-guest
Date: 2005-12-16 21:35:37 +0000 (Fri, 16 Dec 2005)
New Revision: 1653
Added:
packages/libconfig-auto-perl/trunk/t/00.load.t
packages/libconfig-auto-perl/trunk/t/colon.t
packages/libconfig-auto-perl/trunk/t/config/
packages/libconfig-auto-perl/trunk/t/debconf.t
packages/libconfig-auto-perl/trunk/t/nsswitch.t
packages/libconfig-auto-perl/trunk/t/passwd.t
packages/libconfig-auto-perl/trunk/t/pod.t
packages/libconfig-auto-perl/trunk/t/resolv.t
packages/libconfig-auto-perl/trunk/t/winini.t
packages/libconfig-auto-perl/trunk/t/xml.t
Removed:
packages/libconfig-auto-perl/trunk/t/01_Config-Auto.t
Modified:
packages/libconfig-auto-perl/trunk/Changes
packages/libconfig-auto-perl/trunk/MANIFEST
packages/libconfig-auto-perl/trunk/debian/changelog
packages/libconfig-auto-perl/trunk/lib/Config/Auto.pm
Log:
New upstream version 0.14
Modified: packages/libconfig-auto-perl/trunk/Changes
===================================================================
--- packages/libconfig-auto-perl/trunk/Changes 2005-12-16 21:35:01 UTC (rev 1652)
+++ packages/libconfig-auto-perl/trunk/Changes 2005-12-16 21:35:37 UTC (rev 1653)
@@ -1,3 +1,37 @@
+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 at 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
@@ -2,3 +36,2 @@
-
0.05 Tue Feb 10 13:16:59 2004
Modified: packages/libconfig-auto-perl/trunk/MANIFEST
===================================================================
--- packages/libconfig-auto-perl/trunk/MANIFEST 2005-12-16 21:35:01 UTC (rev 1652)
+++ packages/libconfig-auto-perl/trunk/MANIFEST 2005-12-16 21:35:37 UTC (rev 1653)
@@ -3,4 +3,20 @@
Makefile.PL
README
lib/Config/Auto.pm
-t/01_Config-Auto.t
+t/00.load.t
+t/colon.t
+t/config/colon.conf
+t/config/config.xml
+t/config/deb.conf
+t/config/nsswitch.conf
+t/config/passwd
+t/config/resolv.conf
+t/config/win.ini
+t/debconf.t
+t/nsswitch.t
+t/passwd.t
+t/pod.t
+t/resolv.t
+t/winini.t
+t/xml.t
+
Modified: packages/libconfig-auto-perl/trunk/debian/changelog
===================================================================
--- packages/libconfig-auto-perl/trunk/debian/changelog 2005-12-16 21:35:01 UTC (rev 1652)
+++ packages/libconfig-auto-perl/trunk/debian/changelog 2005-12-16 21:35:37 UTC (rev 1653)
@@ -1,3 +1,9 @@
+libconfig-auto-perl (0.14-1) UNRELEASED; urgency=low
+
+ * (NOT RELEASED YET) New upstream release
+
+ -- Niko Tyni <ntyni at iki.fi> Fri, 16 Dec 2005 23:35:07 +0200
+
libconfig-auto-perl (0.06-1) unstable; urgency=low
* Initial Release (Closes: #233240)
Modified: packages/libconfig-auto-perl/trunk/lib/Config/Auto.pm
===================================================================
--- packages/libconfig-auto-perl/trunk/lib/Config/Auto.pm 2005-12-16 21:35:01 UTC (rev 1652)
+++ packages/libconfig-auto-perl/trunk/lib/Config/Auto.pm 2005-12-16 21:35:37 UTC (rev 1653)
@@ -8,10 +8,11 @@
use Config::IniFiles;
use Carp;
-use vars qw[$VERSION $DisablePerl];
+use vars qw[$VERSION $DisablePerl $Untaint $Format];
-$VERSION = '0.06';
+$VERSION = '0.14';
$DisablePerl = 0;
+$Untaint = 0;
my %methods = (
perl => \&eval_perl,
@@ -25,17 +26,18 @@
list => \&return_list,
);
-delete $methods{'xml'}
+delete $methods{'xml'}
unless eval { require XML::Simple; XML::Simple->import; 1 };
sub parse {
my $file = shift;
my %args = @_;
-
- $file = find_file() if not defined $file;
- croak "No config filename given!" if not defined $file;
- croak "Config file $file not readable!" if not -e $file;
+ $file = find_file($file,$args{path}) if not defined $file or
+ not -e $file;
+ croak "No config file found!" if not defined $file;
+ croak "Config file $file not readable!" if not -e $file;
+
return if -B $file;
my $method;
@@ -66,9 +68,11 @@
$method = $methods[0];
} else {
croak "Unknown format $args{format}: use one of @{[ keys %methods ]}"
- if not exists $methods{$args{format}};
- $method = $args{format};
+ if not exists $methods{ lc $args{format} };
+ $method = lc $args{format};
}
+
+ $Format = $method;
return $methods{$method}->($file);
}
@@ -77,17 +81,17 @@
return (xml => 100) if $data_r->[0] =~ /^\s*<\?xml/;
return (perl => 100) if $data_r->[0] =~ /^#!.*perl/;
my %score;
-
+
for (@$data_r) {
# 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|(</\w+.*?>)|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 /^[^:]+:[^:=]+/;
@@ -95,7 +99,7 @@
$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*{$/;
@@ -129,20 +133,61 @@
}
sub find_file {
+ my($file,$path) = @_;
+
my $x;
my $whoami = basename($0);
my $bindir = dirname($0);
- $whoami =~ s/\.pl$//;
- for ("${whoami}config", "${whoami}.config", "${whoami}rc", ".${whoami}rc") {
- return $_ if -e $_;
- return $x if -e ($x=catfile($bindir,$_));
- return $x if -e ($x=catfile($ENV{HOME},$_));
- return "/etc/$_" if -e "/etc/$_";
+
+ $whoami =~ s/\.(pl|t)$//;
+
+ my @filenames = $file ||
+ ("${whoami}config", "${whoami}.config",
+ "${whoami}rc", ".${whoami}rc");
+
+
+ foreach my $filename (@filenames) {
+ return $filename if -e $filename;
+ return $x if ($x = _chkpaths($path,$filename)) and -e $x;
+ return $x if -e ($x = catfile($bindir,$filename));
+ return $x if -e ($x = catfile($ENV{HOME},$filename));
+ return "/etc/$filename" if -e "/etc/$filename";
+ return "/usr/local/etc/$filename"
+ if -e "/usr/local/etc/$filename";
}
return undef;
}
-sub eval_perl { do $_[0]; }
+sub _chkpaths {
+ my ($paths,$filename)=@_;
+ my $file;
+
+ if ($paths) {
+
+ if(ref($paths) eq 'ARRAY') {
+ foreach my $path (@$paths) {
+ return $file if -e ($file = catfile($path,$filename));
+ }
+
+ } else {
+ return $file if -e ($file = catfile($paths,$filename));
+ }
+
+ } else {
+ return undef;
+ }
+}
+
+sub eval_perl {
+ my $file = shift;
+ ($file) = $file =~ m/^(.*)$/s if $Untaint;
+ my $cfg = do $file;
+ croak __PACKAGE__ . " couldn't parse $file: $@" if $@;
+ croak __PACKAGE__ . " couldn't do $file: $!" unless defined $cfg;
+ croak __PACKAGE__ . " couldn't run $file" unless $cfg;
+ return $cfg;
+}
+
sub parse_xml { return XMLin(shift); }
sub parse_ini { tie my %ini, 'Config::IniFiles', (-file=>$_[0]); return \%ini; }
sub return_list { open my $fh, shift or die $!; return [<$fh>]; }
@@ -158,13 +203,13 @@
open IN, $file or die $!;
my %config;
while (<IN>) {
- next if /^\s*#/;
+ next if /^\s*#/;
/^\s*(.*?)\s*:\s*(.*)/ or next;
my ($k, $v) = ($1, $2);
my @v;
if ($v =~ /:/) {
@v = split /:/, $v;
- } elsif ($v =~ /, /) {
+ } elsif ($v =~ /, /) {
@v = split /\s*,\s*/, $v;
} elsif ($v =~ / /) {
@v = split /\s+/, $v;
@@ -183,14 +228,14 @@
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 (/(.*)=(.*)/) { ($subkey, $subvalue) = ($1,$2); }
else { $subkey = $1; $subvalue = 1; }
- if (exists $c->{$k} and ref $c->{$k} ne "HASH") {
+ if (exists $c->{$k} and ref $c->{$k} ne "HASH") {
# Can we find a hash in here?
my $h=undef;
for (@{$c->{$k}}) {
@@ -199,16 +244,16 @@
if ($h) { $h->{$subkey} = $subvalue; }
else { push @{$c->{$k}}, { $subkey => $subvalue } }
} else {
- $c->{$k}{$subkey} = $subvalue;
- }
+ $c->{$k}{$subkey} = $subvalue;
+ }
}
} elsif (@v == 1) {
- if (exists $c->{$k}) {
+ 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 (exists $c->{$k}) {
if (ref $c->{$k} eq "HASH") { $c->{$k}{$_} = 1 for @v }
else {push @{$c->{$k}}, @v }
}
@@ -223,7 +268,7 @@
my %config;
while (<IN>) {
next if /^\s*#/;
- /^\s*(.*?)\s*=\s*(.*)\s*$/ or next;
+ /^\s*(.*?)\s*=\s*(.*)\s*$/ or next;
my ($k, $v) = ($1, $2);
my @v;
if ($v=~ /,/) {
@@ -234,7 +279,7 @@
$config{$k} = $v;
}
}
-
+
return \%config;
}
@@ -244,7 +289,7 @@
my %config;
while (<IN>) {
next if /^\s*#/;
- /\s*(\S+)\s+(.*)/ or next;
+ /\s*(\S+)\s+(.*)/ or next;
my ($k, $v) = ($1, $2);
my @v;
if ($v=~ /,/) {
@@ -284,7 +329,7 @@
=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".
+for some variety of colon-separated config. I decided "never again".
When you call C<Config::Auto::parse> with no arguments, we first look at
C<$0> to determine the program's name. Let's assume that's C<snerk>. We
@@ -293,16 +338,22 @@
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<paths> 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
@@ -313,6 +364,15 @@
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>.
+
+When using the perl format, your configuration file will be eval'd using
+do(file). This will cause taint errors if the filename is not untainted. 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
@@ -356,6 +416,76 @@
...
};
+=head1 PARAMETERS
+
+Although C<Config::Auto> is at its most magical when called with no parameters,
+its behavior can be reined in by use of one or two arguments.
+
+If a filename is passed as the first argument to C<parse>, the same paths are
+checked, but C<Config::Auto> will look for a file with the passed name instead
+of the C<$0>-based names.
+
+ use Config::Auto;
+
+ my $config = Config::Auto::parse("obscure.conf");
+
+The above call will cause C<Config::Auto> to look for:
+
+ obscure.conf
+ ~/obscure.conf
+ /etc/obscure.conf
+
+Parameters after the first are named.
+
+=head2 C<format>
+
+forces C<Config::Auto> to interpret the contents of the
+configuration file in the given format without trying to guess.
+
+=head2 C<path>
+
+add additional directories to the search paths. The current directory
+is searched first, then the paths specified with the path parameter.
+C<path> can either be a scalar or a reference to an array of paths to check.
+
+=head2 Formats
+
+C<Config::Auto> 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., ??)
+
+=back
+
+
+=head1 TROUBLESHOOTING
+
+=over 4
+
+=item When using a Perl config file, the configuration is borked
+
+Give C<Config::Auto> more hints (e.g., add #!/usr/bin/perl to beginning of
+file) or indicate the format in the parse() command.
+
+=back
+
=head1 TODO
BIND9 and irssi file format parsers currently don't exist. It would be
Copied: packages/libconfig-auto-perl/trunk/t/00.load.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/00.load.t)
Deleted: packages/libconfig-auto-perl/trunk/t/01_Config-Auto.t
===================================================================
--- packages/libconfig-auto-perl/trunk/t/01_Config-Auto.t 2005-12-16 21:35:01 UTC (rev 1652)
+++ packages/libconfig-auto-perl/trunk/t/01_Config-Auto.t 2005-12-16 21:35:37 UTC (rev 1653)
@@ -1,100 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 18 };
-use Config::Auto;
-ok(1); # If we made it this far, we're ok.
-
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
-sub t {
- open OUT, ">test.config" or die $!;
- print OUT @_;
- close OUT;
- my $c = Config::Auto::parse("test.config");
- unlink "test.config";
- return $c;
-}
-
-my $c;
-$c = t(<<EOF);
-search oucs.ox.ac.uk ox.ac.uk
-nameserver 163.1.2.1
-nameserver 129.67.1.1
-nameserver 129.67.1.180
-EOF
-
-ok(ref ($c->{nameserver}) eq "ARRAY");
-ok($c->{nameserver}[0] eq "163.1.2.1");
-ok(ref ($c->{search}) eq "ARRAY");
-
-$c = t(<<EOF);
-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
-EOF
-
-ok(ref($c->{root}) eq "ARRAY");
-ok($c->{root}[0] eq "x");
-
-$c = t(<<EOF);
-# 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
-EOF
-
-ok($c->{MOZILLA_DSP} eq "auto");
-
-$c = t(<<EOF);
-# /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
-shadow: compat
-
-hosts: files dns
-EOF
-
-ok($c->{passwd} eq "compat");
-ok(ref $c->{hosts} eq "ARRAY");
-
-$c = t(<<EOF);
-test: foo=bar
-test: baz
-quux: zoop
-
-EOF
-
-ok($c->{quux} eq "zoop");
-ok(ref $c->{test} eq "HASH");
-ok($c->{test}{foo} eq "bar");
-ok($c->{test}{baz} == 1);
-
-$c = t(<<EOF);
-[group1]
-host = proxy.some-domain-name.com
-port = 80
-username = blah
-password = doubleblah
-EOF
-
-ok(ref $c->{"group1"} eq "HASH");
-ok($c->{"group1"}{"host"} eq "proxy.some-domain-name.com");
-ok($c->{"group1"}{"port"} eq "80");
-ok($c->{"group1"}{"username"} eq "blah");
-ok($c->{"group1"}{"password"} eq "doubleblah");
-
Copied: packages/libconfig-auto-perl/trunk/t/colon.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/colon.t)
Copied: packages/libconfig-auto-perl/trunk/t/config (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/config)
Copied: packages/libconfig-auto-perl/trunk/t/debconf.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/debconf.t)
Copied: packages/libconfig-auto-perl/trunk/t/nsswitch.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/nsswitch.t)
Copied: packages/libconfig-auto-perl/trunk/t/passwd.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/passwd.t)
Copied: packages/libconfig-auto-perl/trunk/t/pod.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/pod.t)
Copied: packages/libconfig-auto-perl/trunk/t/resolv.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/resolv.t)
Copied: packages/libconfig-auto-perl/trunk/t/winini.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/winini.t)
Copied: packages/libconfig-auto-perl/trunk/t/xml.t (from rev 1652, packages/libconfig-auto-perl/branches/upstream/current/t/xml.t)
More information about the Pkg-perl-cvs-commits
mailing list