From c33ee741c44bcf61cd89997da05f065d8088c039 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 11:23:59 -0500 Subject: [PATCH 1/6] 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 b8e22ea2..734fbf81 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -94,7 +94,7 @@ use warnings; $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} @@ -154,6 +154,19 @@ use warnings; 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; + } } @@ -281,7 +294,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 ab5b71961b14ba84d20dae605119d1deb5a90627 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 23:19:23 -0500 Subject: [PATCH 2/6] 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 734fbf81..a55d2a58 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -93,12 +93,13 @@ use warnings; || [ 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; @@ -155,18 +156,6 @@ use warnings; 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; - } } @@ -214,6 +203,10 @@ use warnings; 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); } @@ -224,6 +217,19 @@ use warnings; # 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 0e54845c4531eb030b53bfccb5ef336e5e66a26e Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sat, 14 Jun 2014 23:19:41 -0500 Subject: [PATCH 3/6] 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 3fe03509cef2f94195dabe48c56ef3b1d8891540 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sun, 10 May 2015 08:46:20 -0500 Subject: [PATCH 4/6] 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 134d89ad59b5c4bd80f8cf0ef10be4cd8cc2e0a7 Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sun, 10 May 2015 08:52:27 -0500 Subject: [PATCH 5/6] 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 a55d2a58..ac69c9c3 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -219,6 +219,8 @@ use warnings; } 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; @@ -280,33 +282,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 From 5372c9430a99796c2b246a7878b90bde7f3abedb Mon Sep 17 00:00:00 2001 From: pilcrow Date: Sun, 10 Aug 2025 20:27:54 -0500 Subject: [PATCH 6/6] Update comments for clarity; slight tightening of column width computation. --- lib/DBD/Sponge.pm | 22 +++++++++++++--------- t/xx_sponge.t | 10 ++++++++-- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/lib/DBD/Sponge.pm b/lib/DBD/Sponge.pm index ac69c9c3..b5e1f225 100644 --- a/lib/DBD/Sponge.pm +++ b/lib/DBD/Sponge.pm @@ -97,9 +97,11 @@ use warnings; || [ (0) x $numFields ]; $sth->{NULLABLE} = $attribs->{NULLABLE} || [ (2) x $numFields ]; + # Allow user to specify precision, otherwise + # FETCH will lazily compute if needed if ($attribs->{PRECISION}) { $sth->{PRECISION} = $attribs->{PRECISION}; - } # else FETCH will dynamically compute + } } $outer; @@ -203,11 +205,12 @@ use warnings; sub FETCH { my ($sth, $attrib) = @_; # would normally validate and only fetch known attributes + # else pass up to DBI to handle + if ($attrib eq 'PRECISION') { - # prepare() did _not_ specify PRECISION. We'll only get here once. + # prepare() did _not_ specify PRECISION, so lazily compute it now return $sth->{PRECISION} = _max_col_lengths(@{$sth}{'NUM_OF_FIELDS', 'rows'}); } - # else pass up to DBI to handle return $sth->SUPER::FETCH($attrib); } @@ -219,18 +222,19 @@ use warnings; } 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; + # compute our columns' PRECISION (data length) by looking for the + # max lengths of each column's data, row by row + my ($num_of_fields, $rows) = @_; + my @precision = (0,) x $num_of_fields; + my $n = $num_of_fields - 1; my $len; for my $row (@$rows) { - for my $i (0 .. $numFields - 1) { + for my $i (0 .. $n) { next unless defined($len = length($row->[$i])); $precision[$i] = $len if $len > $precision[$i]; } } - return wantarray ? @precision : \@precision; + return \@precision; } } diff --git a/t/xx_sponge.t b/t/xx_sponge.t index 50cc1685..226f4352 100644 --- a/t/xx_sponge.t +++ b/t/xx_sponge.t @@ -11,13 +11,18 @@ use DBI qw(:sql_types); # our reference table: # -# A1 B1 C2 +# A0 B1 C2 # ------- --------- ------- # foo NULL bazooka # foolery bar NULL # NULL barrowman baz # +# Historically, DBD::Sponge defaulted an sth's PRECISION to the length +# of its column names, meaning that some DBI shells could truncate row +# display. For example, formatting a row ('fo', NULL, 'ba') from our +# reference table above. + our @NAMES = ( 'A0', 'B1', 'C2' ); our @ROWS = (['foo', undef, 'bazooka'], ['foolery', 'bar', undef ], @@ -46,7 +51,8 @@ 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 +# Test that DBD-Sponge preserves bogus user-supplied attributes but +# ignores them when returning rows $sth = $dbh->prepare('user-supplied silly TYPE and PRECISION', { rows => dclone( \@ROWS ), NAME => [qw( first_col second_col third_col )],