some fixes / new test for DBD::CSV

From 0f2faad502a6b6d4baad8a8468d7f9112ed79e27 Mon Sep 17 00:00:00 2001
From: Jens Rehsack <[email protected]>
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 <[email protected]>
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 <[email protected]>
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 <[email protected]>
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