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.

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

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();

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</_skip_namespace_frames> as declared
-on the B<first> 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
 

lib/DBIx/Class/ResultSet.pm

@@ -2126,107 +2126,6 @@ C<total_entries> on the L<Data::Page> 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);
 }
 

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;

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) {

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 };

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;

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 = {};