From: Peter Rabbitson Date: Mon, 27 Sep 2010 07:27:39 +0000 (+0200) Subject: Make Data::Page total count evaluation lazy X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=65245220;p=dbsrgits%2FDBIx-Class-Historic.git Make Data::Page total count evaluation lazy The short version is - now you can do $rs->pager->total_entries($satanic_num) and DBIC will never even try to fire a COUNT query This may seem to be a *lot* of code to do something that could be done with a trivial subclass. However keep in mind that this is a proof-of-concept of what do we do when we can *not* (or do not want to) subclass. --- diff --git a/Changes b/Changes index b91006b..b0e0a2a 100644 --- a/Changes +++ b/Changes @@ -14,6 +14,12 @@ Revision history for DBIx::Class - FilterColumn now passes data through when transformations are not specified rather than throwing an exception. - Optimized RowNum based Oracle limit-dialect (RT#61277) + - Requesting a pager on a resultset with cached entries now + throws an exception, instead of returning a 1-page object + since the amount of rows is always equal to the "pagesize" + - $rs->pager now uses a lazy count to determine the amount of + total entries only when really needed, instead of doing it + at instantiation time * Fixes - Fix memory leak during populate() on 5.8.x perls diff --git a/Makefile.PL b/Makefile.PL index cac6e77..f10d2d9 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -66,6 +66,7 @@ my $runtime_requires = { 'Path::Class' => '0.18', 'SQL::Abstract' => '1.68', 'Sub::Name' => '0.04', + 'Variable::Magic' => '0.44', 'Data::Dumper::Concise' => '1.000', 'Scope::Guard' => '0.03', 'Context::Preserve' => '0.01', diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 0e09041..dcc23b8 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -10,7 +10,8 @@ use Storable; use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultSourceHandle; use List::Util (); -use Scalar::Util 'blessed'; +use Scalar::Util qw/blessed weaken/; +use Try::Tiny; use namespace::clean; use overload @@ -949,6 +950,7 @@ sub next { return $cache->[$self->{all_cache_position}++]; } if ($self->{attrs}{cache}) { + delete $self->{pager}; $self->{all_cache_position} = 1; return ($self->all)[0]; } @@ -1804,11 +1806,115 @@ C on the L object. =cut +# make a wizard good for both a scalar and a hashref +my $mk_lazy_count_wizard = sub { + require Variable::Magic; + + my $stash = { total_rs => shift }; + my $slot = shift; # only used by the hashref magic + + my $magic = Variable::Magic::wizard ( + data => sub { $stash }, + + (!$slot) + ? ( + # the scalar magic + get => sub { + # set value lazily, and dispell for good + ${$_[0]} = $_[1]{total_rs}->count; + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}); + return 1; + }, + set => sub { + # an explicit set implies dispell as well + # the unless() is to work around "fun and giggles" below + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}) + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + return 1; + }, + ) + : ( + # the uvar magic + fetch => sub { + if ($_[2] eq $slot and !$_[1]{inactive}) { + my $cnt = $_[1]{total_rs}->count; + $_[0]->{$slot} = $cnt; + + # attempting to dispell in a fetch handle (works in store), seems + # to invariable segfault on 5.10, 5.12, 5.13 :( + # so use an inactivator instead + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++; + } + return 1; + }, + store => sub { + if (! $_[1]{inactive} and $_[2] eq $slot) { + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++ + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + } + return 1; + }, + ), + ); + + $stash->{magic_selfref} = $magic; + weaken ($stash->{magic_selfref}); # this fails on 5.8.1 + + return $magic; +}; + +# the tie class for 5.8.1 +{ + package DBIx::Class::__DBIC_LAZY_RS_COUNT__; + use base qw/Tie::Hash/; + + sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} } + sub NEXTKEY { each %{$_[0]{data}} } + sub EXISTS { exists $_[0]{data}{$_[1]} } + sub DELETE { delete $_[0]{data}{$_[1]} } + sub CLEAR { %{$_[0]{data}} = () } + sub SCALAR { scalar %{$_[0]{data}} } + + sub TIEHASH { + $_[1]{data} = {%{$_[1]{selfref}}}; + %{$_[1]{selfref}} = (); + Scalar::Util::weaken ($_[1]{selfref}); + return bless ($_[1], $_[0]); + }; + + sub FETCH { + if ($_[1] eq $_[0]{slot}) { + my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count; + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + return $cnt; + } + else { + $_[0]{data}{$_[1]}; + } + } + + sub STORE { + $_[0]{data}{$_[1]} = $_[2]; + if ($_[1] eq $_[0]{slot}) { + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + } + $_[2]; + } +} + sub pager { my ($self) = @_; return $self->{pager} if $self->{pager}; + if ($self->get_cache) { + $self->throw_exception ('Pagers on cached resultsets are not supported'); + } + my $attrs = $self->{attrs}; $self->throw_exception("Can't create pager for non-paged rs") unless $self->{attrs}{page}; @@ -1818,13 +1924,69 @@ sub pager { # with a subselect) to get the real total count my $count_attrs = { %$attrs }; delete $count_attrs->{$_} for qw/rows offset page pager/; - my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count; + my $total_rs = (ref $self)->new($self->result_source, $count_attrs); + + +### the following may seem awkward and dirty, but it's a thought-experiment +### necessary for future development of DBIx::DS. Do *NOT* change this code +### before talking to ribasushi/mst - return $self->{pager} = Data::Page->new( - $total_count, + my $pager = Data::Page->new( + 0, #start with an empty set $attrs->{rows}, - $self->{attrs}{page} + $self->{attrs}{page}, ); + + my $data_slot = 'total_entries'; + + # Since we are interested in a cached value (once it's set - it's set), every + # technique will detach from the magic-host once the time comes to fire the + # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself) + + if ($] < 5.008003) { + # 5.8.1 throws 'Modification of a read-only value attempted' when one tries + # to weakref the magic container :( + # tested on 5.8.1 + tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__', + { slot => $data_slot, total_rs => $total_rs, selfref => $pager } + ); + } + elsif ($] < 5.010) { + # We can use magic on the hash value slot. It's interesting that the magic is + # attached to the hash-slot, and does *not* stop working once I do the dummy + # assignments after the cast() + # tested on 5.8.3 and 5.8.9 + my $magic = $mk_lazy_count_wizard->($total_rs); + Variable::Magic::cast ( $pager->{$data_slot}, $magic ); + + # this is for fun and giggles + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this does not work for scalars, but works with + # uvar magic below + #my %vals = %$pager; + #%$pager = (); + #%{$pager} = %vals; + } + else { + # And the uvar magic + # works on 5.10.1, 5.12.1 and 5.13.4 in its current form, + # however see the wizard maker for more notes + my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot); + Variable::Magic::cast ( %$pager, $magic ); + + # still works + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this now works + my %vals = %$pager; + %$pager = (); + %{$pager} = %vals; + } + + return $self->{pager} = $pager; } =head2 page diff --git a/t/67pager.t b/t/67pager.t index b017afb..1835d6d 100644 --- a/t/67pager.t +++ b/t/67pager.t @@ -2,26 +2,49 @@ use strict; use warnings; use Test::More; +use Test::Exception; use lib qw(t/lib); use DBICTest; my $schema = DBICTest->init_schema(); +is ($schema->resultset("CD")->count, 5, 'Initial count sanity check'); + +my $qcnt; +$schema->storage->debugcb(sub { $qcnt++ }); +$schema->storage->debug (1); + +my $rs = $schema->resultset("CD"); + # first page -my $it = $schema->resultset("CD")->search( +$qcnt = 0; +my $it = $rs->search( {}, { order_by => 'title', rows => 3, page => 1 } ); +my $pager = $it->pager; +is ($qcnt, 0, 'No queries on rs/pager creation'); -is( $it->pager->entries_on_this_page, 3, "entries_on_this_page ok" ); +is ($pager->entries_per_page, 3, 'Pager created with correct entries_per_page'); +ok ($pager->current_page(-1), 'Set nonexistent page'); +is ($pager->current_page, 1, 'Page set behaves correctly'); +ok ($pager->current_page(2), 'Set 2nd page'); -is( $it->pager->next_page, 2, "next_page ok" ); +is ($qcnt, 0, 'No queries on total_count-independent methods'); -is( $it->count, 3, "count on paged rs ok" ); +is( $it->pager->entries_on_this_page, 2, "entries_on_this_page ok for page 2" ); + +is ($qcnt, 1, 'Count fired to get pager page entries'); -is( $it->pager->total_entries, 5, "total_entries ok" ); +$qcnt = 0; +is ($pager->previous_page, 1, 'Correct previous_page'); +is ($pager->next_page, undef, 'No more pages'); +is ($qcnt, 0, 'No more counts - amount of entries cached in pager'); + +is( $it->count, 3, "count on paged rs ok" ); +is ($qcnt, 1, 'An $rs->count still fires properly'); is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" ); @@ -30,8 +53,9 @@ $it->next; is( $it->next, undef, "next past end of page ok" ); + # second page, testing with array -my @page2 = $schema->resultset("CD")->search( +my @page2 = $rs->search( {}, { order_by => 'title', rows => 3, @@ -41,7 +65,7 @@ my @page2 = $schema->resultset("CD")->search( is( $page2[0]->title, "Generic Manufactured Singles", "second page first title ok" ); # page a standard resultset -$it = $schema->resultset("CD")->search( +$it = $rs->search( {}, { order_by => 'title', rows => 3 } @@ -52,8 +76,9 @@ is( $page->count, 2, "standard resultset paged rs count ok" ); is( $page->next->title, "Generic Manufactured Singles", "second page of standard resultset ok" ); + # test software-based limit paging -$it = $schema->resultset("CD")->search( +$it = $rs->search( {}, { order_by => 'title', rows => 3, @@ -69,7 +94,7 @@ is( $it->count, 2, "software count on paged rs ok" ); is( $it->next->title, "Generic Manufactured Singles", "software iterator->next ok" ); # test paging with chained searches -$it = $schema->resultset("CD")->search( +$it = $rs->search( {}, { rows => 2, page => 2 } @@ -77,23 +102,15 @@ $it = $schema->resultset("CD")->search( is( $it->count, 2, "chained searches paging ok" ); -my $p = sub { $schema->resultset("CD")->page(1)->pager->entries_per_page; }; - -is($p->(), 10, 'default rows is 10'); - -$schema->default_resultset_attributes({ rows => 5 }); - -is($p->(), 5, 'default rows is 5'); - # test page with offset -$it = $schema->resultset('CD')->search({}, { +$it = $rs->search({}, { rows => 2, page => 2, offset => 1, order_by => 'cdid' }); -my $row = $schema->resultset('CD')->search({}, { +my $row = $rs->search({}, { order_by => 'cdid', offset => 3, rows => 1 @@ -101,4 +118,61 @@ my $row = $schema->resultset('CD')->search({}, { is($row->cdid, $it->first->cdid, 'page with offset'); + +# test pager on non-title page behavior +$qcnt = 0; +$it = $rs->search({}, { rows => 3 })->page (2); +ok ($it->pager); +is ($qcnt, 0, 'No count on past-first-page pager instantiation'); + +is ($it->pager->current_page, 2, 'Page set properby by $rs'); +is( $it->pager->total_entries, 5, 'total_entries correct' ); + +$rs->create ({ artist => 1, title => 'MOAR!', year => 2010 }); +is( $it->count, 3, 'Dynamic count on filling up page' ); +$rs->create ({ artist => 1, title => 'MOAR!!!', year => 2011 }); +is( $it->count, 3, 'Count still correct (does not overflow' ); + +$qcnt = 0; +is( $it->pager->total_entries, 5, 'total_entries properly cached at old value' ); +is ($qcnt, 0, 'No queries'); + +# test fresh pager with explicit total count assignment +$qcnt = 0; +$pager = $rs->search({}, { rows => 4 })->page (2)->pager; +$pager->total_entries (13); + +is ($pager->current_page, 2, 'Correct start page'); +is ($pager->next_page, 3, 'One more page'); +is ($pager->last_page, 4, 'And one more page'); +is ($pager->previous_page, 1, 'One page in front'); + +is ($qcnt, 0, 'No queries with explicitly sey total count'); + +# test cached resultsets +my $init_cnt = $rs->count; + +$it = $rs->search({}, { rows => 3, cache => 1 })->page(3); +is ($it->count, 1, 'One row'); +is (scalar $it->all, 1, 'One object'); + +$it->delete; +is ($rs->count, $init_cnt - 1, 'One row deleted as expected'); + +is ($it->count, 1, 'One row (cached)'); +is (scalar $it->all, 1, 'One object (cached)'); + +throws_ok { $it->pager } + qr/Pagers on cached resultsets are not supported/, 'No pagers on cached resultsets'; + +# test fresh rs creation with modified defaults +my $p = sub { $schema->resultset('CD')->page(1)->pager->entries_per_page; }; + +is($p->(), 10, 'default rows is 10'); + +$schema->default_resultset_attributes({ rows => 5 }); + +is($p->(), 5, 'default rows is 5'); + + done_testing;