r70944 - in /trunk/libconfig-auto-perl: Changes META.yml Makefile.PL debian/changelog lib/Config/Auto.pm t/01_OO.t t/02_parse.t t/03_invalid.t t/04_magic.t t/20_XML_unvailable.t
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Wed Mar 9 06:36:43 UTC 2011
Author: carnil
Date: Wed Mar 9 06:36:18 2011
New Revision: 70944
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70944
Log:
* Team upload.
* New upstream release
+ Handles gracefully cases where config file does not exist
(Closes: #617305)
Modified:
trunk/libconfig-auto-perl/Changes
trunk/libconfig-auto-perl/META.yml
trunk/libconfig-auto-perl/Makefile.PL
trunk/libconfig-auto-perl/debian/changelog
trunk/libconfig-auto-perl/lib/Config/Auto.pm
trunk/libconfig-auto-perl/t/01_OO.t
trunk/libconfig-auto-perl/t/02_parse.t
trunk/libconfig-auto-perl/t/03_invalid.t
trunk/libconfig-auto-perl/t/04_magic.t
trunk/libconfig-auto-perl/t/20_XML_unvailable.t
Modified: trunk/libconfig-auto-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/Changes?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/Changes (original)
+++ trunk/libconfig-auto-perl/Changes Wed Mar 9 06:36:18 2011
@@ -1,3 +1,7 @@
+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
Modified: trunk/libconfig-auto-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/META.yml?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/META.yml (original)
+++ trunk/libconfig-auto-perl/META.yml Wed Mar 9 06:36:18 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Config-Auto
-version: 0.32
+version: 0.34
abstract: Magical config file parser
author:
- Jos I. Boumans <kane at cpan.org>
Modified: trunk/libconfig-auto-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/Makefile.PL?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/Makefile.PL (original)
+++ trunk/libconfig-auto-perl/Makefile.PL Wed Mar 9 06:36:18 2011
@@ -24,15 +24,15 @@
'File::Temp' => 0,
'IO::String' => 0,
};
-delete $prereqs->{'XML::Simple'} unless $opts->{'x'};
+delete $prereqs->{'XML::Simple'} unless $opts->{'x'};
WriteMakefile(
'NAME' => 'Config::Auto',
'VERSION_FROM' => 'lib/Config/Auto.pm', # finds $VERSION
- 'PREREQ_PM' => $prereqs,
- ( $] >= 5.005
- ? ( ABSTRACT_FROM => 'lib/Config/Auto.pm',
- AUTHOR => 'Jos I. Boumans <kane at cpan.org>')
+ 'PREREQ_PM' => $prereqs,
+ ( $] >= 5.005
+ ? ( ABSTRACT_FROM => 'lib/Config/Auto.pm',
+ AUTHOR => 'Jos I. Boumans <kane at cpan.org>')
: ()
),
);
Modified: trunk/libconfig-auto-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/debian/changelog?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/debian/changelog (original)
+++ trunk/libconfig-auto-perl/debian/changelog Wed Mar 9 06:36:18 2011
@@ -1,5 +1,15 @@
+libconfig-auto-perl (0.34-1) UNRELEASED; urgency=low
+
+ * Team upload.
+ * New upstream release
+ + Handles gracefully cases where config file does not exist
+ (Closes: #617305)
+
+ -- Salvatore Bonaccorso <carnil at debian.org> Wed, 09 Mar 2011 07:26:51 +0100
+
libconfig-auto-perl (0.32-1) unstable; urgency=low
+ [ Alessandro Ghedini ]
* New upstream release
* Switch to 3.0 (quilt)
* Bump debhelper to 8
Modified: trunk/libconfig-auto-perl/lib/Config/Auto.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/lib/Config/Auto.pm?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/lib/Config/Auto.pm (original)
+++ trunk/libconfig-auto-perl/lib/Config/Auto.pm Wed Mar 9 06:36:18 2011
@@ -7,7 +7,7 @@
use vars qw[$VERSION $DisablePerl $Untaint $Debug];
-$VERSION = '0.32';
+$VERSION = '0.34';
$DisablePerl = 0;
$Untaint = 0;
$Debug = 0;
@@ -17,31 +17,31 @@
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
+ $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
+ $file = $ca->file; # config filename
$aref = $ca->data; # data from your config, split by newlines
=cut
@@ -117,7 +117,7 @@
=over 4
-=item a filehandle
+=item a filehandle
Any opened filehandle, or C<IO::Handle>/C<IO::String> object.
@@ -131,7 +131,7 @@
=item nothing
-A heuristic will be applied to find your config file, based on the name of
+A heuristic will be applied to find your config file, based on the name of
your script; C<$0>.
=back
@@ -139,30 +139,30 @@
Although C<Config::Auto> 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<source> argument, the same paths are checked,
-but C<Config::Auto> will look for a file with the passed name instead of the
+If a filename is passed as the C<source> argument, 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.
-Supplying the C<path> parameter will 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
+Supplying the C<path> parameter will 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.
-The C<format> parameters forces C<Config::Auto> to interpret the contents of
+The C<format> parameters forces C<Config::Auto> 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] ) {
+ 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;
@@ -173,7 +173,7 @@
### invalid format
croak "No such format '$format'" unless $Methods{$format};
-
+
$self->format( $format );
}
@@ -182,7 +182,7 @@
$self->$key( defined $hash{$key} ? $hash{$key} : '' );
}
- return $self;
+ return $self;
}
=head2 $rv = $obj->parse | Config::Auto::parse( [$text|$fh|$filename, path => \@paths, format => FORMAT_NAME] );
@@ -198,36 +198,40 @@
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, @_ )
+ $self = __PACKAGE__->new( source => $self, @_ )
or croak( "Could not parse '$self' => @_" );
}
- ### from Toru Marumoto: Config-Auto return undef if -B $file
+ 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 at 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
+ ### 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! " .
+ croak "File format unclear! " .
join ",", map { "$_ => $score->{$_}"} @methods
if $score->{ $methods[0] } == $score->{ $methods[1] };
}
@@ -235,7 +239,7 @@
$self->_debug( "Using the following format for parsing: " . $self->format );
}
- }
+ }
return $Methods{ $self->format }->($self);
}
@@ -246,7 +250,7 @@
'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
+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<format> option explicitly to the C<new()> method.
@@ -269,9 +273,9 @@
YAML
(?::|\s) # a YAML: or YAML[space]
/x and $data->[0] eq $_;
- $score{yaml} += 20 if /^---/ 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*#/;
@@ -330,33 +334,33 @@
=cut
-sub data {
+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 {
+ } else {
my $fh = $self->fh;
my @data = <$fh>;
$self->_data( \@data );
-
+
seek $fh, 0, 0; # reset position!
}
-
- return $self->_data;
+
+ return $self->_data;
}
=head2 $fh = $obj->fh;
@@ -367,7 +371,7 @@
=cut
-sub fh {
+sub fh {
my $self = shift;
return $self->_fh if $self->_fh;
@@ -380,18 +384,18 @@
### 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 ) {
+
+ if( open $fh, $file ) {
$self->_fh( $fh );
} else {
$self->_debug( "Could not open '$file': $!" );
@@ -410,7 +414,7 @@
=cut
-sub file {
+sub file {
my $self = shift;
return $self->_file if $self->_file;
@@ -422,22 +426,22 @@
### 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;
}
@@ -450,30 +454,30 @@
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}config", "${whoami}.config",
"${whoami}rc", ".${whoami}rc");
my $try;
@@ -484,12 +488,12 @@
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"
+ return "/usr/local/etc/$name"
if -e "/usr/local/etc/$name";
}
-
+
$self->_debug( "Could not find file for '". $self->source ."'" );
-
+
return;
}
@@ -503,17 +507,17 @@
for my $path ( ref($paths) eq 'ARRAY' ? @$paths : $paths ) {
return $file if -e ($file = catfile($path, $filename));
}
-
- return;
+
+ 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;
@@ -524,44 +528,44 @@
### Check if XML::Simple is already loaded
unless ( exists $INC{'XML/Simple.pm'} ) {
- ### make sure we give good diagnostics when XML::Simple is not
+ ### 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 $@;
- }
-
+ croak "XML::Simple not available. Can not parse " .
+ $self->as_string . "\nError: $@\n" if $@;
+ }
+
return XML::Simple::XMLin( $self->as_string );
}
-sub _parse_ini {
+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
+ ### 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;
-
+ $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
+### Changed to YAML::Any which selects the fastest YAML parser available
### (req YAML 0.67)
-sub _yaml {
- my $self = shift;
- require YAML::Any;
+sub _yaml {
+ my $self = shift;
+ require YAML::Any;
return YAML::Any::Load( $self->as_string );
}
@@ -574,8 +578,8 @@
sub _colon_sep {
my $self = shift;
my $fh = $self->fh;
-
- my %config;
+
+ my %config;
while (<$fh>) {
next if /^\s*#/;
/^\s*(.*?)\s*:\s*(.*)/ or next;
@@ -610,13 +614,13 @@
my ($subkey, $subvalue);
### If the array element has an equal sign in it...
- if (/(.*)=(.*)/) {
- ($subkey, $subvalue) = ($1,$2);
-
+ if (/(.*)=(.*)/) {
+ ($subkey, $subvalue) = ($1,$2);
+
###...otherwise, if the array element does not contain an equals sign:
- } else {
- $subkey = $_;
- $subvalue = 1;
+ } else {
+ $subkey = $_;
+ $subvalue = 1;
}
if (exists $c->{$k} and ref $c->{$k} ne "HASH") {
@@ -647,53 +651,53 @@
{ ### only load Text::ParseWords once;
my $loaded_tp;
-
+
sub _equal_sep {
my $self = shift;
my $fh = $self->fh;
-
- my %config;
+
+ my %config;
while (<$fh>) {
next if /^\s*#/;
next unless /^\s*(.*?)\s*=\s*(.*)\s*$/;
-
+
my ($k, $v) = ($1, $2);
my @v;
-
+
### 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++;
-
+
@v = Text::ParseWords::shellwords($v);
} else {
$config{$k} = $v;
}
}
-
+
return \%config;
}
-
+
sub _space_sep {
my $self = shift;
my $fh = $self->fh;
-
+
my %config;
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++;
@@ -705,13 +709,13 @@
$self->_check_hash_and_assign(\%config, $k, @v);
}
return \%config;
-
- }
-}
-sub _debug {
+
+ }
+}
+sub _debug {
my $self = shift;
my $msg = shift or return;
-
+
Carp::confess( __PACKAGE__ . $msg ) if $Debug;
}
@@ -725,7 +729,7 @@
=head3 $DisablePerl
Set this variable to true if you do not wish to C<eval> perl style configuration
-files.
+files.
Default is C<false>
@@ -745,25 +749,25 @@
=head1 HOW IT WORKS
-When you call C<< Config::Auto->new >> or C<Config::Auto::parse> with no
-arguments, we first look at C<$0> to determine the program's name. Let's
+When you call C<< Config::Auto->new >> or 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 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
@@ -783,7 +787,7 @@
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
+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
@@ -836,7 +840,7 @@
=head1 MEMORY USAGE
This module is as light as possible on memory, only using modules when they
-are absolutely needed for configuration file parsing.
+are absolutely needed for configuration file parsing.
=head1 TROUBLESHOOTING
@@ -866,7 +870,7 @@
=head1 COPYRIGHT
-This library is free software; you may redistribute and/or modify it
+This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut
Modified: trunk/libconfig-auto-perl/t/01_OO.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/t/01_OO.t?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/t/01_OO.t (original)
+++ trunk/libconfig-auto-perl/t/01_OO.t Wed Mar 9 06:36:18 2011
@@ -15,18 +15,18 @@
{ 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" );
@@ -38,4 +38,4 @@
ok( $href, " Score computed" );
isa_ok( $href, 'HASH', " Return value" );
ok( scalar(keys(%$href)), " Scores found" );
-}
+}
Modified: trunk/libconfig-auto-perl/t/02_parse.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/t/02_parse.t?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/t/02_parse.t (original)
+++ trunk/libconfig-auto-perl/t/02_parse.t Wed Mar 9 06:36:18 2011
@@ -13,13 +13,13 @@
my $Map = {
# format # key = text, value = expected result
- colon => {
+ colon => {
qq[
test: foo=bar
test: baz
quux: zoop
] => { test => { foo => 'bar', baz => 1 }, quux => 'zoop' },
-
+
qq[
# /etc/nsswitch.conf
#
@@ -42,7 +42,7 @@
bin => [qw|x 2 2 bin /bin /bin/sh |],
},
},
-
+
equal => {
qq[
@@ -59,7 +59,7 @@
qq[
set foo "bar, baby"
] => { set => ['foo', 'bar, baby'] },
-
+
qq[
search oucs.ox.ac.uk ox.ac.uk
nameserver 163.1.2.1
@@ -69,7 +69,7 @@
nameserver => [qw|163.1.2.1 129.67.1.1 129.67.1.180|],
},
},
-
+
xml => {
qq[
<?xml version="1.0" encoding="UTF-8"?>
@@ -81,12 +81,12 @@
<name>Tests & Failures</name>
</main>
</config>
-] => { main => { title => 'test blocks',
+] => { main => { title => 'test blocks',
url => 'http://www.example.com',
name => 'Tests & Failures' },
urlreader => { start => 'home.html' },
- },
- },
+ },
+ },
yaml => {
qq[
@@ -95,7 +95,7 @@
foo: bar
] => { test => { foo => 'bar' } },
},
-
+
ini => {
qq[
[group1]
@@ -103,15 +103,15 @@
port = 80
username = blah
password = doubleblah
-] => { group1 => { host => 'proxy.some-domain-name.com',
+] => { 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
+ ### don't leave an empty trailing newline, it'll create an
### empty entry
qq[
foo
@@ -119,7 +119,7 @@
-baz
] => [ qw|foo +bar -baz| ],
},
-
+
perl => {
q[
#!/usr/bin/perl
@@ -135,9 +135,9 @@
### 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
@@ -145,99 +145,99 @@
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) )
+ 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
+
+ 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" );
+ " 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//;
-
+ $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" );
}
-}
+}
Modified: trunk/libconfig-auto-perl/t/03_invalid.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/t/03_invalid.t?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/t/03_invalid.t (original)
+++ trunk/libconfig-auto-perl/t/03_invalid.t Wed Mar 9 06:36:18 2011
@@ -14,12 +14,12 @@
{ 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;
+
+ my $rv = $obj->$Method;
ok( scalar(keys %$rv), " Got return value from '$Method'" );
is( $warnings, '', " No warnings recorded" );
}
-}
+}
Modified: trunk/libconfig-auto-perl/t/04_magic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/t/04_magic.t?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/t/04_magic.t (original)
+++ trunk/libconfig-auto-perl/t/04_magic.t Wed Mar 9 06:36:18 2011
@@ -3,7 +3,7 @@
use Test::More 'no_plan';
BEGIN { chdir 't' if -d 't'; }
-
+
my $Class = 'Config::Auto';
@@ -13,7 +13,7 @@
{ 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" );
Modified: trunk/libconfig-auto-perl/t/20_XML_unvailable.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-auto-perl/t/20_XML_unvailable.t?rev=70944&op=diff
==============================================================================
--- trunk/libconfig-auto-perl/t/20_XML_unvailable.t (original)
+++ trunk/libconfig-auto-perl/t/20_XML_unvailable.t Wed Mar 9 06:36:18 2011
@@ -11,8 +11,8 @@
{ my $obj = $Class->new( source => $$.$/, format => 'xml' );
ok( $obj, "Object created" );
-
- eval { $obj->parse };
+
+ eval { $obj->parse };
ok( $@, "parse() on xml dies without XML::Simple" );
like( $@, qr/XML::Simple/, " Error message is informative" );
}
More information about the Pkg-perl-cvs-commits
mailing list