Re: DBD::Sponge: When malloc throws in the sponge

[Steffen Goeldner]

Tim Bunce wrote:
On Wed, Mar 16, 2005 at 01:13:00AM +0100, Steffen Goeldner wrote:
Currently, a result set has to be completely materialized
on the client before it can be fetched via DBD::Sponge:

Large result sets may exhaust available memory. We could
reduce memory usage at the cost of CPU time:

In DBD::Sponge, the fetch method needs to deal with the
code reference:
 sub fetch {
   ...
   my $rows = $sth->{rows};
   my $row = ref $rows eq 'CODE' ? $rows->() : shift @$rows;
Of course, DBD::Sponge is no longer absorptive.
Any opinions?
Yes, yes. Patches welcome etc etc :)
O.k., attached.
Beware, we are now able to produce infinite result sets!
Steffen
Index: lib/DBD/Sponge.pm
===================================================================
--- lib/DBD/Sponge.pm   (revision 929)
+++ lib/DBD/Sponge.pm   (working copy)
@@ -183,7 +183,8 @@
     sub fetch {
        my ($sth) = @_;
-       my $row = shift @{$sth->{'rows'}};
+       my $rows = $sth->{rows};
+       my $row = ref $rows eq 'CODE' ? $rows->() : shift @$rows;
        unless ($row) {
            $sth->STORE(Active => 0);
            return undef;
@@ -264,7 +265,8 @@

 =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 or as a subroutine.

 =item *

Index: MANIFEST
===================================================================
--- MANIFEST    (revision 929)
+++ MANIFEST    (working copy)
@@ -52,6 +52,7 @@
 t/09trace.t
 t/10examp.t
 t/11fetch.t
+t/11fetch2.t
 t/14utf8.t
 t/15array.t
 t/20meta.t
Index: t/11fetch2.t
===================================================================
--- t/11fetch2.t        (revision 0)
+++ t/11fetch2.t        (revision 0)
@@ -0,0 +1,21 @@
+use strict;
+use Test::More;
+use DBI();
+
+my ( $min, $max ) = ( 11, 14 );
+
+plan tests => 2 * ( 1 + $max - $min ) + 1;
+
+sub sth {
+  my ( $min, $max ) = @_;
+  DBI->connect('dbi:Sponge:')->prepare('',{ NUM_OF_FIELDS => 2, rows => sub {
+    return $_ > $max ? undef : ["+$_","-$_"] for $min++
+  }})
+}
+for ( my $sth = sth( $min, $max ); my $row = $sth->fetch; $min++ ) {
+  is( $row->[0],"+$min","field 1: $row->[0]");
+  is( $row->[1],"-$min","field 2: $row->[1]");
+}
+is( $min, $max + 1,'count');
+
+1;