From: Peter Rabbitson Date: Sun, 7 Aug 2011 10:41:46 +0000 (+0200) Subject: Remove the transparrent hook lazy-pager-count experiment X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cd1228209f685767668163c2510723959951641b;p=dbsrgits%2FDBIx-Class-Historic.git Remove the transparrent hook lazy-pager-count experiment It has proven a very stable and reliable implementation, but in the quest for fatpacked DBIC should now go to the archives. --- diff --git a/Changes b/Changes index 536b62a..3139ec3 100644 --- a/Changes +++ b/Changes @@ -5,6 +5,10 @@ Revision history for DBIx::Class - Fix the find() condition heuristics being invoked even when the call defaults to 'primary' (i.e. when invoked with bare values) + * Misc + - No longer depend on Variable::Magic now that a pure-perl + namespace::clean is available + 0.08195 2011-07-27 16:20 (UTC) * Fixes - Fix horrible oversight in the Oracle sqlmaker when dealing with diff --git a/Makefile.PL b/Makefile.PL index 7fd81e6..dc44dee 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -53,20 +53,21 @@ my $runtime_requires = { 'Hash::Merge' => '0.12', 'MRO::Compat' => '0.09', 'Module::Find' => '0.06', + 'namespace::clean' => '0.20', 'Path::Class' => '0.18', 'Scope::Guard' => '0.03', 'SQL::Abstract' => '1.72', 'Try::Tiny' => '0.04', - 'Data::Compare' => '1.22', # XS (or XS-dependent) libs 'DBI' => '1.57', - 'namespace::clean' => '0.20', 'Sub::Name' => '0.04', - 'Variable::Magic' => '0.44', # dual-life corelibs needing a specific bugfixed version 'File::Path' => '2.07', + + # FIXME - temporary, needs throwing out for something more efficient + 'Data::Compare' => '1.22', }; @@ -279,6 +280,7 @@ no_index directory => $_ for (qw| no_index package => $_ for (qw/ DBIx::Class::Storage::DBIHacks DBIx::Class::Carp + DBIx::Class::ResultSet::Pager /); WriteAll(); diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm index 5f40094..002b6e2 100644 --- a/lib/DBIx/Class/Carp.pm +++ b/lib/DBIx/Class/Carp.pm @@ -5,9 +5,9 @@ use warnings; # This is here instead of DBIx::Class because of load-order issues BEGIN { - ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading - # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie() - # see if this starts working + # something is tripping up V::M on 5.8.1, leading to segfaults. + # A similar test in n::c itself is disabled on 5.8.1 for the same + # reason. There isn't much motivation to try to find why it happens *DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN = ($] < 5.008005) ? sub () { 1 } : sub () { 0 } @@ -30,6 +30,15 @@ sub __find_caller { my @f; while (@f = caller($fr_num++)) { last unless $f[0] =~ $skip_pattern; + + # + if ( + $f[0]->can('_skip_namespace_frames') + and + my $extra_skip = $f[0]->_skip_namespace_frames + ) { + $skip_pattern = qr/$skip_pattern|$extra_skip/; + } } my ($ln, $calling) = @f # if empty - nothing matched - full stack @@ -133,7 +142,8 @@ In addition to the classic interface: this module also supports a class-data based way to specify the exclusion regex. A message is only carped from a callsite that matches neither the closed over string, nor the value of L as declared -on the B callframe origin. +on any callframe already skipped due to the same mechanism. This is to ensure +that intermediate callsites can declare their own additional skip-namespaces. =head1 CLASS ATTRIBUTES diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 8348678..dee7c30 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2126,107 +2126,6 @@ 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 # hide from pause - 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) = @_; @@ -2245,70 +2144,15 @@ 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_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 + my $total_rs = (ref $self)->new($self->result_source, $count_attrs); - require Data::Page; - my $pager = Data::Page->new( - 0, #start with an empty set + require DBIx::Class::ResultSet::Pager; + return $self->{pager} = DBIx::Class::ResultSet::Pager->new( + sub { $total_rs->count }, #lazy-get the total $attrs->{rows}, $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 @@ -3710,6 +3554,11 @@ sub STORABLE_freeze { # A cursor in progress can't be serialized (and would make little sense anyway) delete $to_serialize->{cursor}; + # nor is it sensical to store a not-yet-fired-count pager + if ($to_serialize->{pager} and ref $to_serialize->{pager}{total_entries} eq 'CODE') { + delete $to_serialize->{pager}; + } + Storable::nfreeze($to_serialize); } diff --git a/lib/DBIx/Class/ResultSet/Pager.pm b/lib/DBIx/Class/ResultSet/Pager.pm new file mode 100644 index 0000000..e8510c3 --- /dev/null +++ b/lib/DBIx/Class/ResultSet/Pager.pm @@ -0,0 +1,21 @@ +package # hide from pause + DBIx::Class::ResultSet::Pager; + +use warnings; +use strict; + +use base 'Data::Page'; +use mro 'c3'; + +# simple support for lazy totals +sub _total_entries_accessor { + if (@_ == 1 and ref $_[0]->{total_entries} eq 'CODE') { + return $_[0]->{total_entries} = $_[0]->{total_entries}->(); + } + + return shift->next::method(@_); +} + +sub _skip_namespace_frames { qr/^Data::Page/ } + +1; diff --git a/t/52leaks.t b/t/52leaks.t index 5111b67..1a052ef 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -188,8 +188,6 @@ unless (DBICTest::RunMode->is_plain) { result_source_handle => $rs->result_source->handle, - fresh_pager => $rs->page(5)->pager, - pager => $pager, pager_explicit_count => $pager_explicit_count, }; @@ -203,6 +201,8 @@ unless (DBICTest::RunMode->is_plain) { storage => $storage, sql_maker => $storage->sql_maker, dbh => $storage->_dbh, + fresh_pager => $rs->page(5)->pager, + pager => $pager, ); if ($has_dt) { diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t index f11fa51..b922aa5 100644 --- a/t/55namespaces_cleaned.t +++ b/t/55namespaces_cleaned.t @@ -60,6 +60,10 @@ my $skip_idx = { map { $_ => 1 } ( # G::L::D is unclean, but we never inherit from it 'DBIx::Class::Admin::Descriptive', 'DBIx::Class::Admin::Usage', + + # this subclass is expected to inherit whatever crap comes + # from the parent + 'DBIx::Class::ResultSet::Pager', ) }; my $has_cmop = eval { require Class::MOP }; diff --git a/t/67pager.t b/t/67pager.t index b7eb2ca..eb17faa 100644 --- a/t/67pager.t +++ b/t/67pager.t @@ -5,6 +5,7 @@ use Test::More; use Test::Exception; use lib qw(t/lib); use DBICTest; +use Storable qw/dclone/; my $schema = DBICTest->init_schema(); @@ -186,5 +187,32 @@ $schema->default_resultset_attributes({ rows => 5 }); is($p->(), 5, 'default rows is 5'); +# does serialization work (preserve laziness, while preserving state if exits) +$qcnt = 0; +$it = $rs->search( + {}, + { order_by => 'title', + rows => 5, + page => 2 } +); +$pager = $it->pager; +is ($qcnt, 0, 'No queries on rs/pager creation'); + +$it = do { local $DBIx::Class::ResultSourceHandle::thaw_schema = $schema; dclone ($it) }; +is ($qcnt, 0, 'No queries on rs/pager freeze/thaw'); + +is( $it->pager->entries_on_this_page, 1, "entries_on_this_page ok for page 2" ); + +is ($qcnt, 1, 'Count fired to get pager page entries'); + +$rs->create({ title => 'bah', artist => 1, year => 2011 }); + +$qcnt = 0; +$it = do { local $DBIx::Class::ResultSourceHandle::thaw_schema = $schema; dclone ($it) }; +is ($qcnt, 0, 'No queries on rs/pager freeze/thaw'); + +is( $it->pager->entries_on_this_page, 1, "entries_on_this_page ok for page 2, even though underlying count changed" ); + +is ($qcnt, 0, 'No count fired on pre-existing total count'); done_testing; diff --git a/xt/podcoverage.t b/xt/podcoverage.t index be4bbbb..f67a2f0 100644 --- a/xt/podcoverage.t +++ b/xt/podcoverage.t @@ -149,6 +149,9 @@ my $exceptions = { # skipped because the synopsis covers it clearly 'DBIx::Class::InflateColumn::File' => { skip => 1 }, + +# internal subclass, nothing to POD + 'DBIx::Class::ResultSet::Pager' => { skip => 1 }, }; my $ex_lookup = {};