Hi Merijn,
as talked in IRC here are the patches. They currently cover the 2 things
I missed tests for (file-handle, col_names + skip_rows).
You can do me a favour and apply the attached patches using
'git am' and modify them later (allows me to fast-forward instead
of merging).
Thanks,
Jens
>From 0f2faad502a6b6d4baad8a8468d7f9112ed79e27 Mon Sep 17 00:00:00 2001
From: Jens Rehsack <s...@netbsd.org>
Date: Fri, 26 Oct 2012 13:24:16 +0200
Subject: [PATCH 1/4] remove / alias relict
---
lib/DBD/CSV.pm | 25 ++++++++++++-------------
1 file changed, 12 insertions(+), 13 deletions(-)
diff --git a/lib/DBD/CSV.pm b/lib/DBD/CSV.pm
index 1b49c43..fed3c85 100755
--- a/lib/DBD/CSV.pm
+++ b/lib/DBD/CSV.pm
@@ -238,8 +238,7 @@ sub open_file {
my ($self, $meta, $attrs, $flags) = @_;
$self->SUPER::open_file ($meta, $attrs, $flags);
- my $tbl = $meta;
- if ($tbl && $tbl->{fh}) {
+ if ($meta && $meta->{fh}) {
$attrs->{csv_csv_in} = $meta->{csv_in};
$attrs->{csv_csv_out} = $meta->{csv_out};
if (my $types = $meta->{types}) {
@@ -253,7 +252,7 @@ sub open_file {
: Text::CSV_XS::PV ();
push @$t, $_;
}
- $tbl->{types} = $t;
+ $meta->{types} = $t;
}
if (!$flags->{createMode}) {
my $array;
@@ -265,29 +264,29 @@ sub open_file {
defined $meta->{skip_rows} or
$meta->{skip_rows} = $skipRows;
if ($skipRows--) {
- $array = $attrs->{csv_csv_in}->getline ($tbl->{fh}) or
+ $array = $attrs->{csv_csv_in}->getline ($meta->{fh}) or
croak "Missing first row due to ".$attrs->{csv_csv_in}->error_diag;
unless ($meta->{raw_header}) {
s/\W/_/g for @$array;
}
- $tbl->{col_names} = $array;
+ $meta->{col_names} = $array;
while ($skipRows--) {
- $attrs->{csv_csv_in}->getline ($tbl->{fh});
+ $attrs->{csv_csv_in}->getline ($meta->{fh});
}
}
- $tbl->{first_row_pos} = $tbl->{fh}->tell ();
+ $meta->{first_row_pos} = $meta->{fh}->tell ();
exists $meta->{col_names} and
- $array = $tbl->{col_names} = $meta->{col_names};
- if (!$tbl->{col_names} || !@{$tbl->{col_names}}) {
+ $array = $meta->{col_names};
+ if (!$meta->{col_names} || !@{$meta->{col_names}}) {
# No column names given; fetch first row and create default
# names.
- my $ar = $tbl->{cached_row} =
- $attrs->{csv_csv_in}->getline ($tbl->{fh});
- $array = $tbl->{col_names};
+ my $ar = $meta->{cached_row} =
+ $attrs->{csv_csv_in}->getline ($meta->{fh});
+ $array = $meta->{col_names};
push @$array, map { "col$_" } 0 .. $#$ar;
}
my $i = 0;
- $tbl->{col_nums}{$_} = $i++ for @$array; # XXX not necessary for DBI > 1.611
+ $meta->{col_nums}{$_} = $i++ for @$array; # XXX not necessary for DBI > 1.611
}
}
} # open_file
--
1.7.12.2
>From effdff45f57ec9bcbf1f0e682e07dff23f4ec4b9 Mon Sep 17 00:00:00 2001
From: Jens Rehsack <s...@netbsd.org>
Date: Fri, 26 Oct 2012 13:24:53 +0200
Subject: [PATCH 2/4] update csv_tables assignment ...
---
sandbox/rt61513.pl | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sandbox/rt61513.pl b/sandbox/rt61513.pl
index 5b4565b..437e0a0 100644
--- a/sandbox/rt61513.pl
+++ b/sandbox/rt61513.pl
@@ -21,7 +21,7 @@ my $dbh = DBI->connect ( "dbi:CSV:", undef, undef, {
# does *not* work with the csv_tables entry uncommented
-$new or $dbh->{csv_tables}{dinges} = $dinges;
+$new or $dbh->{csv_tables} = { dinges => $dinges };
# now it *does* work
--
1.7.12.2
>From 10ddc3e9e9eb99bf39dd0e5cd5faefd5f88d94b5 Mon Sep 17 00:00:00 2001
From: Jens Rehsack <s...@netbsd.org>
Date: Fri, 26 Oct 2012 16:53:28 +0200
Subject: [PATCH 3/4] do not override user provided column names
---
lib/DBD/CSV.pm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/lib/DBD/CSV.pm b/lib/DBD/CSV.pm
index fed3c85..216403c 100755
--- a/lib/DBD/CSV.pm
+++ b/lib/DBD/CSV.pm
@@ -269,7 +269,8 @@ sub open_file {
unless ($meta->{raw_header}) {
s/\W/_/g for @$array;
}
- $meta->{col_names} = $array;
+ defined $meta->{col_names} or
+ $meta->{col_names} = $array;
while ($skipRows--) {
$attrs->{csv_csv_in}->getline ($meta->{fh});
}
--
1.7.12.2
>From 4d812ce0f401c71aa64656356568e4fea010e14b Mon Sep 17 00:00:00 2001
From: Jens Rehsack <s...@netbsd.org>
Date: Fri, 26 Oct 2012 16:54:29 +0200
Subject: [PATCH 4/4] add tests playing with meta attributes
---
t/61_meta.t | 109 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 109 insertions(+)
create mode 100644 t/61_meta.t
diff --git a/t/61_meta.t b/t/61_meta.t
new file mode 100644
index 0000000..6d418a7
--- /dev/null
+++ b/t/61_meta.t
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use version;
+
+use Test::More;
+use DBI qw(:sql_types);
+use Cwd qw(abs_path);
+do "t/lib.pl";
+
+version->parse (DBD::File->VERSION) >= version->parse ("0.41") or plan (skipall => "DBD::File 0.41 required");
+
+my $cnt;
+while (<DATA>) {
+ $cnt .= $_;
+ }
+my $tbl;
+
+SKIP: {
+ my $data;
+ open ($data, "<", \$cnt);
+ my $dbh = Connect();
+ ok ($tbl = FindNewTable ($dbh), "find new test table");
+
+ skip "memory i/o currently unsupported by DBD::File", 1;
+
+ $dbh->{csv_tables}->{data} = {f_file => $data, skip_rows => 4};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - mem-io w/o col_names" );
+ }
+
+SKIP: {
+ my $data;
+ open ($data, "<", \$cnt);
+ my $dbh = Connect();
+
+ skip "memory i/o currently unsupported by DBD::File", 1;
+
+ $dbh->{csv_tables}->{data} = {f_file => $data, skip_rows => 4, col_names => [qw(id name color)]};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - mem-io w col_names" );
+ }
+
+my $fn = abs_path(DbFile($tbl));
+open( my $fh, ">", $fn ) or die "Can't open $fn for writing: $!";
+print $fh $cnt;
+close($fh);
+
+END { unlink $fn; }
+
+{
+ my $data;
+ open ($data, "<", $fn);
+ my $dbh = Connect();
+ $dbh->{csv_tables}->{data} = {f_file => $data, skip_rows => 4};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - file-handle w/o col_names" );
+ is_deeply( $sth->{NAME_lc}, [qw(id name color)], "column names - file-handle w/o col_names" );
+ }
+
+{
+ my $data;
+ open ($data, "<", $fn);
+ my $dbh = Connect();
+ $dbh->{csv_tables}->{data} = {f_file => $data, skip_rows => 4, col_names => [qw(foo bar baz)]};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - file-handle w col_names" );
+ is_deeply( $sth->{NAME_lc}, [qw(foo bar baz)], "column names - file-handle w col_names" );
+ }
+
+{
+ my $dbh = Connect();
+ $dbh->{csv_tables}->{data} = {f_file => $fn, skip_rows => 4};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - file-name w/o col_names" );
+ is_deeply( $sth->{NAME_lc}, [qw(id name color)], "column names - file-name w/o col_names" );
+ }
+
+{
+ my $dbh = Connect({RaiseError => 1});
+ $dbh->{csv_tables}->{data} = {f_file => $fn, skip_rows => 4, col_names => [qw(foo bar baz)]};
+ my $sth = $dbh->prepare ("SELECT * FROM data");
+ $sth->execute();
+ my $rows = $sth->fetchall_arrayref();
+ is_deeply( $rows, [ [ 1, "Knut", "white" ], [ 2, "Inge", "black" ], [ 3, "Beowulf", "CCEE00" ] ], "all rows found - file-name w col_names" );
+ is_deeply( $sth->{NAME_lc}, [qw(foo bar baz)], "column names - file-name w col_names" );
+ }
+
+done_testing();
+
+__END__
+id,name,color
+stupid content
+only for skipping
+followed by column names
+1,Knut,white
+2,Inge,black
+3,Beowulf,"CCEE00"
--
1.7.12.2
