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: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
