From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 30 Oct 2010 09:42:43 +0000 (+0200)
Subject: Add Storable freeze/thaw hooks to ResultSet to detach active cursors
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0b66414bdc046f0980221e3ef3cfb6945814824a;p=dbsrgits%2FDBIx-Class-Historic.git

Add Storable freeze/thaw hooks to ResultSet to detach active cursors

This allows serialization of resultsets "in-progress". Furthermore
testing revealed cached resultsets are serializable just fine \o/
---

diff --git a/Changes b/Changes
index 588d365..3a9f460 100644
--- a/Changes
+++ b/Changes
@@ -21,6 +21,9 @@ Revision history for DBIx::Class
         - Switch all serialization to use Storable::nfreeze for portable
           architecture independent ice
 
+    * Fixes
+        - Proper serialization of resultsets with open cursors
+
 0.08124 2010-10-28 14:23 (UTC)
     * New Features / Changes
         - Add new -ident "function" indicating rhs is a column name
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 25344b7..46ac2d1 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -12,6 +12,7 @@ use DBIx::Class::ResultSourceHandle;
 use List::Util ();
 use Scalar::Util qw/blessed weaken/;
 use Try::Tiny;
+use Storable qw/nfreeze thaw/;
 use namespace::clean;
 
 use overload
@@ -3309,6 +3310,7 @@ sub _merge_attr {
   return $orig;
 }
 
+
 sub result_source {
     my $self = shift;
 
@@ -3319,6 +3321,27 @@ sub result_source {
     }
 }
 
+
+sub STORABLE_freeze {
+  my ($self, $cloning) = @_;
+  my $to_serialize = { %$self };
+
+  # A cursor in progress can't be serialized (and would make little sense anyway)
+  delete $to_serialize->{cursor};
+
+  return nfreeze($to_serialize);
+}
+
+# need this hook for symmetry
+sub STORABLE_thaw {
+  my ($self, $cloning, $serialized) = @_;
+
+  %$self = %{ thaw($serialized) };
+
+  return $self;
+}
+
+
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/throw_exception> for details.
diff --git a/t/84serialize.t b/t/84serialize.t
index c048151..4738a96 100644
--- a/t/84serialize.t
+++ b/t/84serialize.t
@@ -8,6 +8,7 @@ use DBICTest;
 use Storable qw(dclone freeze nfreeze thaw);
 
 my $schema = DBICTest->init_schema();
+my $orig_debug = $schema->storage->debug;
 
 my %stores = (
     dclone_method           => sub { return $schema->dclone($_[0]) },
@@ -24,7 +25,7 @@ my %stores = (
     },
 );
 
-plan tests => (11 * keys %stores);
+plan tests => (17 * keys %stores);
 
 for my $name (keys %stores) {
     my $store = $stores{$name};
@@ -49,9 +50,9 @@ for my $name (keys %stores) {
 
     my $cd_rs = $artist->search_related("cds");
 
-    # test that a result source can be serialized as well
-
-    $cd_rs->_resolved_attrs;  # this builds up the {from} attr
+    # test that a live result source can be serialized as well
+    is( $cd_rs->count, 3, '3 CDs in database');
+    ok( $cd_rs->next, 'Advance cursor' );
 
     lives_ok {
       $copy = $store->($cd_rs);
@@ -73,6 +74,35 @@ for my $name (keys %stores) {
                   qq[serialize with related_resultset "$key"]);
     }
 
-    ok eval { $copy->discard_changes; 1 } or diag $@;
+    lives_ok(
+      sub { $copy->discard_changes }, "Discard changes works: $name"
+    ) or diag $@;
     is($copy->id, $artist->id, "IDs still match ");
+
+
+    # Test resultsource with cached rows
+    my $query_count;
+    $cd_rs = $cd_rs->search ({}, { cache => 1 });
+
+    $schema->storage->debug(1);
+    $schema->storage->debugcb(sub { $query_count++ } );
+
+    # this will hit the database once and prime the cache
+    my @cds = $cd_rs->all;
+
+    lives_ok {
+      $copy = $store->($cd_rs);
+      is_deeply (
+        [ $copy->all ],
+        [ $cd_rs->all ],
+        "serialize cached resultset works: $name",
+      );
+
+      is ($copy->count, $cd_rs->count, 'Cached count identical');
+    } "serialize cached resultset lives: $name";
+
+    is ($query_count, 1, 'Only one db query fired');
+
+    $schema->storage->debug($orig_debug);
+    $schema->storage->debugcb(undef);
 }
diff --git a/xt/podcoverage.t b/xt/podcoverage.t
index fe4b9c0..cdab30d 100644
--- a/xt/podcoverage.t
+++ b/xt/podcoverage.t
@@ -70,6 +70,12 @@ my $exceptions = {
             resolve_prefetch
         /],
     },
+    'DBIx::Class::ResultSet' => {
+        ignore => [qw/
+            STORABLE_freeze
+            STORABLE_thaw
+        /],
+    },
     'DBIx::Class::ResultSourceHandle' => {
         ignore => [qw/
             schema