perl-embperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Angus Lees <...@inodes.org>
Subject DBIx::Recordset MoreRecords/Next bugs
Date Wed, 18 Sep 2002 03:12:26 GMT

with DBIx::Recordset 0.24 (with my debian bugfix patches applied.
these have been posted here previously), this simple loop works as
expected:

 while (my $rec = $set->Next) {
    print join(',', values %$rec), "\n";
    #print 'morerecords=', ($set->MoreRecords ? 'yes' : 'no'), "\n";
 }

uncommenting the "morerecords" line causes the loop to endlessly print
the last record (on my 2 result query).


the problem is that MoreRecords() fetches the next row, which gets
cached in *LastRecord/*LastRecordFetch.  The next Next() hits this
cache, returning _before_updating_*LastRow_.  Following Next()s will
then keep refetching this same row.


from looking at the FETCH() code, this "cache" doesn't actually
achieve much (the code path for a hit on $data->[$fetch] is already
pretty quick); so i chose to simply remove the cache check altogether,
rather than duplicate later *FetchMax sanity checks, etc again.


this revealed another problem:  Next() tries to work out whether to
fetch the first row or the next row based on whether anything had been
fetched before (whether $self->{'*LastRecord'} is defined).

it needs to do this so that $set->Reset, followed by $set->Next gets
the first row in the table.

when the DBI statement is finished (DBIx::Recordset has read all
results), the last record retrieved (*LastRecord) is undef (thats how
DBI tells you you've reached the end in fact).  Next() thus thinks
we're starting again (or something), doesn't increment the "last row"
counter and ends up using *LastRow again.

since *LastRecord seems to be used in other places to imply various
things, i just changed Reset() and Next() to use *LastRecordFetch to
signify "the row before the first".  just to be safe, i undefine
*LastRecordFetch when a new SQLSelect is performed.

(more discussion after patch)

--- /tmp/libdbix-recordset-perl.orig/Recordset.pm	Wed Sep 18 12:23:42 2002
+++ /home/gus/src/libdbix-recordset-perl-0.24/Recordset.pm	Wed Sep 18 12:23:42 2002
@@ -1314,6 +1314,7 @@
     $self->{'*EOD'} = undef ;
     $self->{'*SelectFields'} = undef ;
     $self->{'*LastRecord'} = undef ;
+    $self->{'*LastRecordFetch'} = undef ;
 
     $order  ||= '' ;
     $expr   ||= '' ;
@@ -1469,8 +1470,6 @@
 
     $fetch += $self->{'*FetchStart'} ;
 
-    return $self->{'*LastRecord'} if (defined ($self->{'*LastRecordFetch'}) &&
$fetch == $self->{'*LastRecordFetch'} && $self->{'*LastRecord'}) ; 
-
     my $max ;
     my $key ;
     my $dat ;                           # row data
@@ -1656,6 +1655,7 @@
     my $self = shift ;
 
     $self->{'*LastRecord'} = undef ;
+    $self->{'*LastRecordFetch'} = undef ;
     $self ->{'*LastRow'}   = 0 ;
     }
 
@@ -1708,7 +1708,7 @@
 
     $lr -= $self -> {'*FetchStart'} ;
     $lr = 0 if ($lr < 0) ;
-    $lr++ if (defined ($self -> {'*LastRecord'})) ;
+    $lr++ if (defined ($self -> {'*LastRecordFetch'})) ;
 
     ##$lr++ if ($_[0] ->{'*CurrRow'} > 0 || $_[0] ->{'*EOD'}) ; 
     my $rec = $self -> FETCH ($lr) ;



this passes "make test" on DBD::Pg, after applying the following
test.pl patch.  PostgreSQL (rightfully, imo) gives a fatal error when
trying to do '.. WHERE value1="String"' when value1 is of type INT.

the DBI::SQL_* changes were necessary, since they're interpreted as
strings otherwise (thanks to '=>').  i can't see how the previous
version could ever have worked..  cleaner would probably be to import
:sql_types from DBI directly.


--- /tmp/libdbix-recordset-perl.orig/test.pl	Wed Sep 18 12:35:37 2002
+++ /home/gus/src/libdbix-recordset-perl-0.24/test.pl	Wed Sep 18 12:35:37 2002
@@ -921,23 +921,29 @@
     printlogf "Select multiply fields 2";
     print LOG "\n--------------------\n" ;
 
+    if ($Driver eq 'Pg') {
+	print "skipped\n";
+    } else {
     $set1 -> Select ({'+name&value1' => "Third Name",
                            '$operator' => '='})  or die "not ok ($DBI::errstr)" ;
 
 
     Check ($Driver eq 'CSV'?[3]:[3, 14], $TestFields[0], \@set1) or print "ok\n" ;
-
+    }
     # ---------------------
 
     printlogf "Select multiply fields & values";
     print LOG "\n--------------------\n" ;
 
+    if ($Driver eq 'Pg') {
+	print "skipped\n";
+    } else {
     $set1 -> Select ({'+name&value1' => "Second Name\t9991",
                            '$operator' => '='})  or die "not ok ($DBI::errstr)" ;
 
 
     Check ($Driver eq 'CSV'?[1,2]:[1,2,14], $TestFields[0], \@set1) or print "ok\n" ;
-
+    }
     # ---------------------
 
     $set1 -> Search ({id => 1,name => 'First Name',addon => 'Is'})  or die "not
ok ($DBI::errstr)" ;
@@ -1412,6 +1418,9 @@
         printlogf "Search multfield *<field>";
         print LOG "\n--------------------\n" ;
 
+	if ($Driver eq 'Pg') {
+	    print "skipped\n";
+	} else {
         $set6 -> Search ({"+$t0\lid|$t0\laddon" =>  "7\tit",
                           "$t0\lname"           =>  'Fourth Name',
                           "\*$t0\lid"            =>  '<',
@@ -1420,6 +1429,7 @@
                           '$conj'               =>  'and' }) or die "not ok ($DBI::errstr)"
;
 
         Check ([1,2,3,5,6,10], ['id', 'name', 'txt'], \@set6) or print "ok\n" ;
+        }
 
         # ---------------------
 
@@ -1428,6 +1438,9 @@
         printlogf "Search \$compconj";
         print LOG "\n--------------------\n" ;
 
+	if ($Driver eq 'Pg') {
+	    print "skipped\n";
+	} else {
         $set6 -> Search ({"+$t0\lid|$t0\laddon"     =>  "6\tit",
                           "$t0\lname"          =>  'Fourth Name',
                           "\*$t0\lid"           =>  '>',
@@ -1444,6 +1457,7 @@
 	    {
 	    Check ([1,3,4,5,7,8,9,10,11], ['id', 'name', 'txt'], \@set6) or print "ok\n" ;
 	    }
+        }
 
 
         # ---------------------
@@ -3588,12 +3602,12 @@
 					     'name2'         =>  '05.10.99',
 					     '!Filter'   => 
 						{
-						DBI::SQL_CHAR     => 
+						DBI::SQL_CHAR()     => 
 						    [ 
 							sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
 							sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}
 						    ],
-						DBI::SQL_VARCHAR     => 
+						DBI::SQL_VARCHAR()     => 
 						    [ 
 							sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
 							sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}
@@ -3688,12 +3702,12 @@
 
             $db -> TableAttr ($Table[1], '!Filter', 
 						    {
-						    DBI::SQL_CHAR     => 
+						    DBI::SQL_CHAR()     => 
 						        [ 
 							    sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
 							    sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}
 						        ],
-						    DBI::SQL_VARCHAR     => 
+						    DBI::SQL_VARCHAR()     => 
 						        [ 
 							    sub { shift =~ /(\d\d)\.(\d\d)\.(\d\d)/ ; "19$3$2$1"},
 							    sub { shift =~ /\d\d(\d\d)(\d\d)(\d\d)/ ; "$3.$2.$1"}


-- 
 - Gus

---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-help@perl.apache.org


Mime
View raw message