Hi Angus, thanks for the patch. Seems to make sense, but I have to go thru it more in details as soon as I have a little bit more time...
Gerald ------------------------------------------------------------- Gerald Richter ecos electronic communication services gmbh Internetconnect * Webserver/-design/-datenbanken * Consulting Post: Tulpenstrasse 5 D-55276 Dienheim b. Mainz E-Mail: [EMAIL PROTECTED] Voice: +49 6133 925131 WWW: http://www.ecos.de Fax: +49 6133 925152 ------------------------------------------------------------- ----- Original Message ----- From: "Angus Lees" <[EMAIL PROTECTED]> To: <[EMAIL PROTECTED]> Sent: Wednesday, September 18, 2002 5:12 AM Subject: DBIx::Recordset MoreRecords/Next bugs > > 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] > > --------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
