[Bast-commits] r9455 - in DBIx-Class/0.08/branches/pg_cursors:
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Pg t
dakkar at dev.catalyst.perl.org
dakkar at dev.catalyst.perl.org
Fri May 28 21:03:51 GMT 2010
Author: dakkar
Date: 2010-05-28 22:03:51 +0100 (Fri, 28 May 2010)
New Revision: 9455
Modified:
DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg/Sth.pm
DBIx-Class/0.08/branches/pg_cursors/t/72pg_cursors.t
Log:
cursor usage can now be switched on/off
default off, turn on via (increasing order of importance):
- package variable on DBIx::Class::Storage::DBI::Pg
- connection attributes
- RS attributes
also, "page" size used for each fetch from cursor can be tweaked in the
same way
Modified: DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg/Sth.pm
===================================================================
--- DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg/Sth.pm 2010-05-28 20:02:08 UTC (rev 9454)
+++ DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg/Sth.pm 2010-05-28 21:03:51 UTC (rev 9455)
@@ -7,10 +7,11 @@
'storage',
'cursor_id', 'cursor_created',
'cursor_sth', 'fetch_sth',
+ 'page_size',
);
sub new {
- my ($class, $storage, $dbh, $sql) = @_;
+ my ($class, $storage, $dbh, $sql, $page_size) = @_;
if ($sql =~ /^SELECT\b/i) {
my $self=bless {},$class;
@@ -24,6 +25,7 @@
$self->cursor_id($csr_id);
$self->cursor_sth($storage->_dbh_sth($dbh,$sql));
$self->cursor_created(0);
+ $self->page_size($page_size);
return $self;
}
else {
@@ -105,7 +107,11 @@
}
$self->fetch_sth->finish if $self->fetch_sth;
- $self->fetch_sth($self->storage->sth("fetch 1000 from ".$self->cursor_id));
+ $self->fetch_sth($self->storage->sth(
+ sprintf 'fetch %d from %s',
+ $self->page_size,
+ $self->cursor_id
+ ));
$self->fetch_sth->execute;
}
Modified: DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg.pm 2010-05-28 20:02:08 UTC (rev 9454)
+++ DBIx-Class/0.08/branches/pg_cursors/lib/DBIx/Class/Storage/DBI/Pg.pm 2010-05-28 21:03:51 UTC (rev 9455)
@@ -20,6 +20,9 @@
__PACKAGE__->mk_group_accessors('simple' =>
'_pg_cursor_number');
+our $DEFAULT_USE_PG_CURSORS=0;
+our $DEFAULT_PG_CURSORS_PAGE_SIZE=1000;
+
sub _supports_insert_returning {
my $self = shift;
@@ -219,14 +222,61 @@
return $ret;
}
+sub __get_tweak_value {
+ my ($self,$attrs,$slot,$default,$extra_test)=@_;
+
+ $extra_test||=sub{1};
+
+ if ( exists $attrs->{$slot}
+ && defined $attrs->{$slot}
+ && $extra_test->($attrs->{$slot})
+ ) {
+ return $attrs->{$slot};
+ }
+ my @info=@{$self->_dbi_connect_info};
+ if ( @info
+ && ref($info[-1]) eq 'HASH'
+ && exists $info[-1]->{$slot}
+ && defined $info[-1]->{$slot}
+ && $extra_test->($info[-1]->{$slot})
+ ) {
+ return $info[-1]->{$slot};
+ }
+ return $default;
+}
+
+sub _should_use_pg_cursors {
+ my ($self,$attrs) = @_;
+
+ return $self->__get_tweak_value($attrs,'use_pg_cursors',$DEFAULT_USE_PG_CURSORS);
+}
+
+sub _get_pg_cursor_page_size {
+ my ($self,$attrs) = @_;
+
+ return $self->__get_tweak_value($attrs,'pg_cursors_page_size',$DEFAULT_PG_CURSORS_PAGE_SIZE,
+ sub { $_[0] =~ /^\d+$/ });
+}
+
+sub _select {
+ my $self = shift;
+ my ($ident, $select, $where, $attrs) = @_;
+
+ local $self->{_use_pg_cursors}=$self->_should_use_pg_cursors($attrs);
+ local $self->{_pg_cursor_page_size}=$self->_get_pg_cursor_page_size($attrs);
+
+ return $self->next::method(@_);
+}
+
sub _dbh_sth {
my ($self, $dbh, $sql) = @_;
- if ($sql =~ /^SELECT\b/i) {
- return DBIx::Class::Storage::DBI::Pg::Sth->new($self,$dbh,$sql);
+ if ($self->{_use_pg_cursors} && $sql =~ /^SELECT\b/i) {
+ return DBIx::Class::Storage::DBI::Pg::Sth
+ ->new($self,$dbh,$sql,$self->{_pg_cursor_page_size});
}
else { # short-circuit
- return $self->SUPER::_dbh_sth($dbh,$sql);
+ return $self->next::method($dbh,$sql);
}
}
Modified: DBIx-Class/0.08/branches/pg_cursors/t/72pg_cursors.t
===================================================================
--- DBIx-Class/0.08/branches/pg_cursors/t/72pg_cursors.t 2010-05-28 20:02:08 UTC (rev 9454)
+++ DBIx-Class/0.08/branches/pg_cursors/t/72pg_cursors.t 2010-05-28 21:03:51 UTC (rev 9455)
@@ -5,14 +5,13 @@
use Test::More;
use lib qw(t/lib);
use DBICTest;
-use Time::HiRes qw(gettimeofday tv_interval);
my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
unless ($dsn && $dbuser);
-plan tests => 3;
+plan tests => 10;
sub create_test_schema {
my ($schema)=@_;
@@ -43,11 +42,16 @@
});
}
-# copied from 100populate.t
-
-my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
+my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1, use_pg_cursors => 1 });
drop_test_schema($schema);create_test_schema($schema);
+my ($called,$page_size)=(0,0);
+my $old_sth_new=\&DBIx::Class::Storage::DBI::Pg::Sth::new;
+*DBIx::Class::Storage::DBI::Pg::Sth::new=sub {
+ ++$called;$page_size=$_[4];
+ goto &$old_sth_new;
+};
+
END {
return unless $schema;
drop_test_schema($schema);
@@ -57,7 +61,9 @@
my $rows=1e4;
my $offset = 3;
+$called=0;
$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } ( 1 .. $rows ) ] );
+is ($called,0,'Pg::Sth not created for insert');
is (
$schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
$rows,
@@ -65,25 +71,29 @@
);
{
+ $called=0;
my $rs=$schema->resultset('Artist')->search({});
my $count=0;
- my $t0=[gettimeofday];
$count++ while $rs->next;
is($count,$rows,'get all the rows (loop)');
- diag('Time for all(loop): '.tv_interval($t0));
+ is($called,1,'Pg::Sth called once per rs');
+ is($page_size,$DBIx::Class::Storage::DBI::Pg::DEFAULT_PG_CURSORS_PAGE_SIZE,'default page size used');
}
{
- my $rs=$schema->resultset('Artist')->search({});
- my $t0=[gettimeofday];
+ $called=0;
+ my $rs=$schema->resultset('Artist')->search({},{pg_cursors_page_size=>10});
$rs->first;
- diag('Time for first: '.tv_interval($t0));
+ is($called,1,'Pg::Sth called again per rs');
+ is($page_size,10,'page size from attrs used');
}
{
+ $called=0;
my $rs=$schema->resultset('Artist')->search({});
- my $t0=[gettimeofday];
my @rows=$rs->all;
is(scalar(@rows),$rows,'get all the rows (all)');
- diag('Time for all: '.tv_interval($t0));
+ is($called,1,'Pg::Sth called again per rs');
+ is($page_size,$DBIx::Class::Storage::DBI::Pg::DEFAULT_PG_CURSORS_PAGE_SIZE,'default page size used again');
}
+
More information about the Bast-commits
mailing list