From bfe5bd2d54b0ae48c43afbb67ae103e585ff3358 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 11:23:59 -0500 Subject: [PATCH 1/5] Correctly compute Sponge PRECISION --- lib/DBD/Sponge.pm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/lib/DBD/Sponge.pm b/lib/DBD/Sponge.pm index c73b735a..d3461aa2 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -92,7 +92,7 @@ $sth->{TYPE} = $attribs->{TYPE} || [ (DBI::SQL_VARCHAR()) x $numFields ]; $sth->{PRECISION} = $attribs->{PRECISION} - || [ map { length($sth->{NAME}->[$_]) } 0..$numFields -1 ]; + || _max_columnar_lengths($numFields, $rows); $sth->{SCALE} = $attribs->{SCALE} || [ (0) x $numFields ]; $sth->{NULLABLE} = $attribs->{NULLABLE} @@ -152,6 +152,19 @@ return $dbh->set_err(42, "not enough parameters") unless @args >= 2; return \@args; } + + sub _max_columnar_lengths { + my ($numFields, $rows) = @_; + my @precision = (0,) x $numFields; + my $len; + for my $row (@$rows) { + for my $i (0 .. $numFields - 1) { + next unless defined $len = length($row->[$i]); + $precision[$i] = $len if $len > $precision[$i]; + } + } + return wantarray ? @precision : \@precision; + } } @@ -279,7 +292,7 @@ The number and order should match the number and ordering of the C<$data> column C<%attr> is a hash of other standard DBI attributes that you might pass to a prepare statement. -Currently only NAME, TYPE, and PRECISION are supported. +Currently only NAME, TYPE, and PRECISION are supported. PRECISION will be automatically computed if not supplied. =back From dea97d185f95bc209e5c69ef015ea68dc047b219 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 23:19:23 -0500 Subject: [PATCH 2/5] lazy PRECISION --- lib/DBD/Sponge.pm | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/lib/DBD/Sponge.pm b/lib/DBD/Sponge.pm index d3461aa2..8c4d68a2 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -91,12 +91,13 @@ || [ map { "col$_" } 1..$numFields ]; $sth->{TYPE} = $attribs->{TYPE} || [ (DBI::SQL_VARCHAR()) x $numFields ]; - $sth->{PRECISION} = $attribs->{PRECISION} - || _max_columnar_lengths($numFields, $rows); $sth->{SCALE} = $attribs->{SCALE} || [ (0) x $numFields ]; $sth->{NULLABLE} = $attribs->{NULLABLE} || [ (2) x $numFields ]; + if ($attribs->{PRECISION}) { + $sth->{PRECISION} = $attribs->{PRECISION}; + } # else FETCH will dynamically compute } $outer; @@ -153,18 +154,6 @@ return \@args; } - sub _max_columnar_lengths { - my ($numFields, $rows) = @_; - my @precision = (0,) x $numFields; - my $len; - for my $row (@$rows) { - for my $i (0 .. $numFields - 1) { - next unless defined $len = length($row->[$i]); - $precision[$i] = $len if $len > $precision[$i]; - } - } - return wantarray ? @precision : \@precision; - } } @@ -212,6 +201,10 @@ sub FETCH { my ($sth, $attrib) = @_; # would normally validate and only fetch known attributes + if ($attrib eq 'PRECISION') { + # prepare() did _not_ specify PRECISION. We'll only get here once. + return $sth->{PRECISION} = _max_col_lengths(@{$sth}{'NUM_OF_FIELDS', 'rows'}); + } # else pass up to DBI to handle return $sth->SUPER::FETCH($attrib); } @@ -222,6 +215,19 @@ # else pass up to DBI to handle return $sth->SUPER::STORE($attrib, $value); } + + sub _max_col_lengths { + my ($numFields, $rows) = @_; + my @precision = (0,) x $numFields; + my $len; + for my $row (@$rows) { + for my $i (0 .. $numFields - 1) { + next unless defined($len = length($row->[$i])); + $precision[$i] = $len if $len > $precision[$i]; + } + } + return wantarray ? @precision : \@precision; + } } 1; From 5b437c24d194c8fabb2323a24ee5be3c145d2764 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 23:19:41 -0500 Subject: [PATCH 3/5] Simple Sponge and PRECISION tests --- t/xx_sponge.t | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 t/xx_sponge.t diff --git a/t/xx_sponge.t b/t/xx_sponge.t new file mode 100644 index 00000000..4a121433 --- /dev/null +++ b/t/xx_sponge.t @@ -0,0 +1,52 @@ +#! /usr/bin/env perl + +# vim: noet ts=2 sw=2: + +use strict; +use warnings; +use Test::More tests => 17; + +use Storable qw(dclone); +use DBI qw(:sql_types); + +our @ROWS = (['foo', undef, 'bazooka'], + ['foolery', 'bar', undef ], + [undef, 'barrowman', 'baz' ]); + +my $dbh = DBI->connect("dbi:Sponge:", '', ''); +ok($dbh, "connect(dbi:Sponge:) succeeds"); + +my $sth = $dbh->prepare("simple, correct sponge", { + rows => dclone( \@ROWS ), + NAME => [ qw(A0 B1 C2) ], + }); + +ok($sth, "prepare() of 3x3 result succeeded"); +is_deeply($sth->{NAME}, ['A0', 'B1', 'C2'], "column NAMEs as expected"); +is_deeply($sth->{TYPE}, [SQL_VARCHAR, SQL_VARCHAR, SQL_VARCHAR], + "column TYPEs default to SQL_VARCHAR"); +is_deeply($sth->{PRECISION}, [7, 9, 7], + "column PRECISION matches lengths of longest field data"); +is_deeply($sth->fetch(), $ROWS[0], "first row fetch as expected"); +is_deeply($sth->fetch(), $ROWS[1], "second row fetch as expected"); +is_deeply($sth->fetch(), $ROWS[2], "third row fetch as expected"); +ok(!defined($sth->fetch()), "fourth fetch returns undef"); + + +$sth = $dbh->prepare('user-supplied silly TYPE and PRECISION', { + rows => dclone( \@ROWS ), + NAME => [qw( first_col second_col third_col )], + TYPE => [SQL_INTEGER, SQL_DATETIME, SQL_CHAR], + PRECISION => [1, 100_000, 0], + }); +ok($sth, "prepare() 3x3 result with TYPE and PRECISION succeeded"); +is_deeply($sth->{NAME}, ['first_col','second_col','third_col'], + "column NAMEs again as expected"); +is_deeply($sth->{TYPE}, [SQL_INTEGER, SQL_DATETIME, SQL_CHAR], + "column TYPEs not overwritten"); +is_deeply($sth->{PRECISION}, [1, 100_000, 0], + "column PRECISION not overwritten"); +is_deeply($sth->fetch(), $ROWS[0], "first row fetch as expected, despite bogus attributes"); +is_deeply($sth->fetch(), $ROWS[1], "second row fetch as expected, despite bogus attributes"); +is_deeply($sth->fetch(), $ROWS[2], "third row fetch as expected, despite bogus attributes"); +ok(!defined($sth->fetch()), "fourth fetch returns undef, despite bogus attributes"); From 2a1c15aed8a14f40854ed30d1025493d17259d19 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sun, 10 May 2015 08:46:20 -0500 Subject: [PATCH 4/5] Explicit commenting of test cases --- t/xx_sponge.t | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/t/xx_sponge.t b/t/xx_sponge.t index 4a121433..50cc1685 100644 --- a/t/xx_sponge.t +++ b/t/xx_sponge.t @@ -9,22 +9,36 @@ use Test::More tests => 17; use Storable qw(dclone); use DBI qw(:sql_types); -our @ROWS = (['foo', undef, 'bazooka'], - ['foolery', 'bar', undef ], - [undef, 'barrowman', 'baz' ]); +# our reference table: +# +# A1 B1 C2 +# ------- --------- ------- +# foo NULL bazooka +# foolery bar NULL +# NULL barrowman baz +# + +our @NAMES = ( 'A0', 'B1', 'C2' ); +our @ROWS = (['foo', undef, 'bazooka'], + ['foolery', 'bar', undef ], + [undef, 'barrowman', 'baz' ]); my $dbh = DBI->connect("dbi:Sponge:", '', ''); ok($dbh, "connect(dbi:Sponge:) succeeds"); my $sth = $dbh->prepare("simple, correct sponge", { rows => dclone( \@ROWS ), - NAME => [ qw(A0 B1 C2) ], + NAME => [ @NAMES ], }); ok($sth, "prepare() of 3x3 result succeeded"); is_deeply($sth->{NAME}, ['A0', 'B1', 'C2'], "column NAMEs as expected"); is_deeply($sth->{TYPE}, [SQL_VARCHAR, SQL_VARCHAR, SQL_VARCHAR], "column TYPEs default to SQL_VARCHAR"); +# +# Old versions of DBD-Sponge defaulted PRECISION (data "length") to +# length of the field _names_ rather than the length of the _data_. +# is_deeply($sth->{PRECISION}, [7, 9, 7], "column PRECISION matches lengths of longest field data"); is_deeply($sth->fetch(), $ROWS[0], "first row fetch as expected"); @@ -32,7 +46,7 @@ is_deeply($sth->fetch(), $ROWS[1], "second row fetch as expected"); is_deeply($sth->fetch(), $ROWS[2], "third row fetch as expected"); ok(!defined($sth->fetch()), "fourth fetch returns undef"); - +# Test that DBD-Sponge preserves bogus user-supplied attributes $sth = $dbh->prepare('user-supplied silly TYPE and PRECISION', { rows => dclone( \@ROWS ), NAME => [qw( first_col second_col third_col )], From 6a279dc00415647fe1383c3aca7c5bb9e684102c Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sun, 10 May 2015 08:52:27 -0500 Subject: [PATCH 5/5] Document PRECISION computation and long-standing default TYPE. Reformat POD --- lib/DBD/Sponge.pm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/lib/DBD/Sponge.pm b/lib/DBD/Sponge.pm index 8c4d68a2..ecc1be4d 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -217,6 +217,8 @@ } sub _max_col_lengths { + # Compute result set PRECISION (data length) by looking for the + # max lengths of each column's data. my ($numFields, $rows) = @_; my @precision = (0,) x $numFields; my $len; @@ -278,33 +280,38 @@ No username and password are needed. =item * -The C<$statement> here is an arbitrary statement or name you want -to provide as identity of your data. If you're using DBI::Profile -it will appear in the profile data. +The C<$statement> here is an arbitrary statement or name you want to +provide as identity of your data. If you're using DBI::Profile it will +appear in the profile data. -Generally it's expected that you are preparing a statement handle -as if a C statement happened. =item * -C<$data> is a reference to the data you are providing, given as an array of arrays. +C<$data> is a reference to the data you are providing, given as an array +of arrays. =item * -C<$names> is a reference an array of column names for the C<$data> you are providing. -The number and order should match the number and ordering of the C<$data> columns. +C<$names> is a reference an array of column names for the C<$data> you +are providing. The number and order should match the number and +ordering of the C<$data> columns. =item * -C<%attr> is a hash of other standard DBI attributes that you might pass to a prepare statement. +C<%attr> is a hash of other standard DBI attributes that you might pass +to a prepare statement. -Currently only NAME, TYPE, and PRECISION are supported. PRECISION will be automatically computed if not supplied. +Currently only NAME, TYPE, and PRECISION are supported. TYPE defaults +to SQL_VARCHAR. PRECISION will be lazily computed if not supplied. =back =head1 BUGS -Using this module to prepare INSERT-like statements is not currently documented. +Using this module to prepare INSERT-like statements is not currently +documented. =head1 AUTHOR AND COPYRIGHT