From: Sven Dowideit <[email protected]>
---
AnyData/Format/Fixed.pm | 4 +++-
Changes | 2 +-
MANIFEST | 3 +++
t/fixed.t | 31 +++++++++++++++++++++++++++++++
t/fixed.tbl | 7 +++++++
t/test.t~ | 40 ----------------------------------------
6 files changed, 45 insertions(+), 42 deletions(-)
create mode 100644 t/fixed.t
create mode 100644 t/fixed.tbl
delete mode 100755 t/test.t~
diff --git a/AnyData/Format/Fixed.pm b/AnyData/Format/Fixed.pm
index d951c03..afdf03e 100644
--- a/AnyData/Format/Fixed.pm
+++ b/AnyData/Format/Fixed.pm
@@ -31,6 +31,8 @@ package AnyData::Format::Fixed;
This is a parser for fixed length record files. You must specify an unpack
pattern listing the widths of the fields e.g. {pattern=>'A3 A7 A20'}. You can
either supply the column names or let the module get them for you from the
first line of the file. In either case, they should be a comma separated
string.
+Refer to L<http://perldoc.perl.org/functions/pack.html> for the formating of
the pattern.
+
Please refer to the documentation for AnyData.pm and DBD::AnyData.pm
for further details.
@@ -70,7 +72,7 @@ sub write_fields {
my @fieldLengths = split /\s+/, $patternStr;
my $fieldStr = '';
for(@fields) {
- next unless $_;
+ next unless defined $_;
# PAD OR TRUNCATE DATA TO FIT WITHIN FIELD LENGTHS
my $oldLen = length $_ || 0;
my $newLen = $fieldLengths[$fieldNum] || 0;
diff --git a/Changes b/Changes
index 880750a..9593473 100644
--- a/Changes
+++ b/Changes
@@ -10,7 +10,7 @@ version 0.11, released Aug 2012
* Fix syntax error in POD documentation (debian) Ansgar Burchardt
<[email protected]>
* Fix spelling errors (debian) Ansgar Burchardt <[email protected]>
* adColumn $distinct_flag not handled (RT#6248 & RT#6251) John D. Lima
-
+ * writing fields containing 0 with AnyData::Format::Fixed (RT#8671)
<elodie+cpan [...] pasteur.fr>
version 0.10, released 19 April 2004
diff --git a/MANIFEST b/MANIFEST
index f803a04..7a52d0c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -23,6 +23,9 @@ AnyData/Storage/PassThru.pm
AnyData/Storage/RAM.pm
AnyData/Storage/TiedHash.pm
t/pod.t
+t/test.t
+t/fixed.t
+t/fixed.tbl
diff --git a/t/fixed.t b/t/fixed.t
new file mode 100644
index 0000000..f2bd342
--- /dev/null
+++ b/t/fixed.t
@@ -0,0 +1,31 @@
+#!/usr/local/bin/perl -wT
+use strict;
+use warnings;
+
+use Test::More;
+plan tests => 6;
+
+use AnyData;
+
+ my $table = adTie( 'Fixed', 't/fixed.tbl', 'r', {pattern=>'A11 A2'} );
+
+ ok(6 == adRows($table), "Failed rows");
+ ok('au' eq $table->{'australia'}->{code}, 'select one');
+ ok('ch' eq $table->{'switzerland'}->{code}, 'select another');
+ ok('0' eq $table->{'broken'}->{code}, 'select another');
+ ok(' 0' eq $table->{'broken2'}->{code}, 'select another');
+
+#write test
+ ok(<<'HERE' eq adExport($table, 'Fixed', undef, {pattern=>'A11 A2'}),
'export fixed format');
+country co
+australia au
+germany de
+france fr
+switzerlandch
+broken 0
+broken2 0
+HERE
+
+#TODO: note that the docco says the column names need to be comma separated,
and the input file has 'country,code', thus the written file would be busted too
+
+__END__
diff --git a/t/fixed.tbl b/t/fixed.tbl
new file mode 100644
index 0000000..02ffb63
--- /dev/null
+++ b/t/fixed.tbl
@@ -0,0 +1,7 @@
+country,code
+australia au
+germany de
+france fr
+switzerlandch
+broken 0
+broken2 0
diff --git a/t/test.t~ b/t/test.t~
deleted file mode 100755
index 30d5abc..0000000
--- a/t/test.t~
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/usr/local/bin/perl -wT
-use strict;
-use warnings;
-
-my @formats = qw(CSV Pipe Tab Fixed Paragraph ARRAY);
-
-use Test::More;
-plan tests => (1+$#formats) * 4;
-
-use AnyData;
-
-
-for my $format( @formats ) {
- printf " %10s ... %s\n", $format, test_ad($format);
-}
-
-sub test_ad {
- my $file = [];
- my $format = shift;
- my $mode = 'o';
- my $flags = {cols=>'name,country,sex',pattern=>'A5 A8 A3'};
- my $table = adTie( $format,$file, $mode, $flags ); # create a table
- $table->{Sue} = {country=>'fr',sex=>'f'}; # insert rows
- $table->{Tom} = {country=>'fr',sex=>'f'};
- $table->{Bev} = {country=>'en',sex=>'f'};
- $table->{{ name=>'Tom'}} = {sex=>'m'}; # update a row
- delete $table->{Bev}; # delete a row
- $flags = {pattern=>'A5 A8 A3'};
- ok('f' eq $table->{Sue}->{sex}, "Failed single select");
- my $tstr;
- while ( my $person = each %$table ) { # select mulitple rows
- $tstr .= $person->{name} if $person->{country} eq 'fr';
- }
- ok('SueTom' eq $tstr, "Failed multiple select");
- ok('namecountrysex' eq join('',adNames($table)), "Failed names");
- ok(2 == adRows($table), "Failed rows");
-}
-
-
-__END__
--
1.7.10.4
