Cleanup ResultSourceHandle handling after M.A.D. introduction
Peter Rabbitson [Thu, 13 Jan 2011 10:20:35 +0000 (11:20 +0100)]
Since a source/schema combos no longer leak, it is safe to store
strong-refs to sources directly in Row/ResultSet objects. Reduce
ResultSourceHandle to a simple Source "meta-layer" to facilitate
serialization of ResultSources.

In the process improve behavior/error messages of objects which
were deserialized without $schema re-attachment

13 files changed:
Changes
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/ResultSourceHandle.pm
lib/DBIx/Class/ResultSourceProxy/Table.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/SQLMaker/LimitDialects.pm
lib/DBIx/Class/Serialize/Storable.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBIHacks.pm
t/52leaks.t
t/60core.t
t/84serialize.t

diff --git a/Changes b/Changes
index a2d952c..b2a1652 100644 (file)
--- a/Changes
+++ b/Changes
@@ -14,6 +14,7 @@ Revision history for DBIx::Class
           SQL areas ( group_by => \[ ... ] now works properly )
         - Allow populate to skip empty has_many relationships which makes
           it easier to pass HashRefInflator data directly to ->populate
+        - Improve freeze/thaw semantics and error messages (RT#62546)
 
     * Misc
         - Fix test warning on win32 - at this point the test suite is
index af8e545..4b5db45 100644 (file)
@@ -3090,8 +3090,8 @@ sub as_subselect_rs {
   return $fresh_rs->search( {}, {
     from => [{
       $attrs->{alias} => $self->as_query,
-      -alias         => $attrs->{alias},
-      -source_handle => $self->result_source->handle,
+      -alias  => $attrs->{alias},
+      -rsrc   => $self->result_source,
     }],
     alias => $attrs->{alias},
   });
@@ -3141,8 +3141,8 @@ sub _chain_relationship {
     );
 
     $from = [{
-      -source_handle => $source->handle,
-      -alias => $attrs->{alias},
+      -rsrc   => $source,
+      -alias  => $attrs->{alias},
       $attrs->{alias} => $rs_copy->as_query,
     }];
     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
@@ -3153,7 +3153,7 @@ sub _chain_relationship {
   }
   else {
     $from = [{
-      -source_handle => $source->handle,
+      -rsrc  => $source,
       -alias => $attrs->{alias},
       $attrs->{alias} => $source->from,
     }];
@@ -3292,8 +3292,8 @@ sub _resolved_attrs {
   $attrs->{as} = \@as;
 
   $attrs->{from} ||= [{
-    -source_handle => $source->handle,
-    -alias => $self->{attrs}{alias},
+    -rsrc   => $source,
+    -alias  => $self->{attrs}{alias},
     $self->{attrs}{alias} => $source->from,
   }];
 
@@ -3620,7 +3620,7 @@ sub STORABLE_freeze {
   # A cursor in progress can't be serialized (and would make little sense anyway)
   delete $to_serialize->{cursor};
 
-  return nfreeze($to_serialize);
+  nfreeze($to_serialize);
 }
 
 # need this hook for symmetry
@@ -3629,7 +3629,7 @@ sub STORABLE_thaw {
 
   %$self = %{ thaw($serialized) };
 
-  return $self;
+  $self;
 }
 
 
index 821f5cb..46ad67a 100644 (file)
@@ -18,7 +18,7 @@ use base qw/DBIx::Class/;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
   _columns _primaries _unique_constraints name resultset_attributes
-  schema from _relationships column_info_from_storage source_info
+  from _relationships column_info_from_storage source_info
   source_name sqlt_deploy_callback/);
 
 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
@@ -367,7 +367,7 @@ sub column_info {
   if ( ! $self->_columns->{$column}{data_type}
        and ! $self->{_columns_info_loaded}
        and $self->column_info_from_storage
-       and $self->schema and my $stor = $self->storage )
+       and my $stor = try { $self->storage } )
   {
     $self->{_columns_info_loaded}++;
 
@@ -445,9 +445,7 @@ sub columns_info {
       and
     $self->column_info_from_storage
       and
-    $self->schema
-      and
-    my $stor = $self->storage
+    my $stor = try { $self->storage }
   ) {
     $self->{_columns_info_loaded}++;
 
@@ -1016,11 +1014,11 @@ sub resultset {
     'call it on the schema instead.'
   ) if scalar @_;
 
-  return $self->resultset_class->new(
+  $self->resultset_class->new(
     $self,
     {
+      try { %{$self->schema->default_resultset_attributes} },
       %{$self->{resultset_attributes}},
-      %{$self->schema->default_resultset_attributes}
     },
   );
 }
@@ -1067,7 +1065,7 @@ clause contents.
 
 =over 4
 
-=item Arguments: None
+=item Arguments: $schema
 
 =item Return value: A schema object
 
@@ -1075,8 +1073,29 @@ clause contents.
 
   my $schema = $source->schema();
 
-Returns the L<DBIx::Class::Schema> object that this result source
-belongs to.
+Sets and/or returns the L<DBIx::Class::Schema> object to which this
+result source instance has been attached to.
+
+=cut
+
+sub schema {
+  if (@_ > 1) {
+    $_[0]->{schema} = $_[1];
+  }
+  else {
+    $_[0]->{schema} || do {
+      my $name = $_[0]->{source_name} || '_unnamed_';
+      my $err = 'Unable to perform storage-dependent operations with a detached result source '
+              . "(source '$name' is not associated with a schema).";
+
+      $err .= ' You need to use $schema->thaw() or manually set'
+            . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
+        if $_[0]->{_detached_thaw};
+
+      DBIx::Class::Exception->throw($err);
+    };
+  }
+}
 
 =head2 storage
 
@@ -1458,7 +1477,7 @@ sub _resolve_join {
 
     my $rel_src = $self->related_source($join);
     return [ { $as => $rel_src->from,
-               -source_handle => $rel_src->handle,
+               -rsrc => $rel_src,
                -join_type => $parent_force_left
                   ? 'left'
                   : $rel_info->{attrs}{join_type}
@@ -1732,16 +1751,31 @@ sub related_class {
 
 =head2 handle
 
-Obtain a new handle to this source. Returns an instance of a
-L<DBIx::Class::ResultSourceHandle>.
+=over 4
+
+=item Arguments: None
+
+=item Return value: $source_handle
+
+=back
+
+Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
+for this source. Used as a serializable pointer to this resultsource, as it is not
+easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
+relationship definitions.
 
 =cut
 
 sub handle {
-    return DBIx::Class::ResultSourceHandle->new({
-        schema         => $_[0]->schema,
-        source_moniker => $_[0]->source_name
-    });
+  return DBIx::Class::ResultSourceHandle->new({
+    source_moniker => $_[0]->source_name,
+
+    # so that a detached thaw can be re-frozen
+    $_[0]->{_detached_thaw}
+      ? ( _detached_source  => $_[0]          )
+      : ( schema            => $_[0]->schema  )
+    ,
+  });
 }
 
 {
@@ -1782,18 +1816,13 @@ sub handle {
   }
 }
 
-sub STORABLE_freeze {
-  my ($self, $cloning) = @_;
-  nfreeze($self->handle);
-}
+sub STORABLE_freeze { nfreeze($_[0]->handle) }
 
 sub STORABLE_thaw {
   my ($self, $cloning, $ice) = @_;
   %$self = %{ (thaw $ice)->resolve };
 }
 
-
-
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/"throw_exception">.
@@ -1803,12 +1832,10 @@ See L<DBIx::Class::Schema/"throw_exception">.
 sub throw_exception {
   my $self = shift;
 
-  if (defined $self->schema) {
-    $self->schema->throw_exception(@_);
-  }
-  else {
-    DBIx::Class::Exception->throw(@_);
-  }
+  $self->{schema}
+    ? $self->{schema}->throw_exception(@_)
+    : DBIx::Class::Exception->throw(@_)
+  ;
 }
 
 =head2 source_info
index 474c9a4..a878613 100644 (file)
@@ -2,44 +2,43 @@ package DBIx::Class::ResultSourceHandle;
 
 use strict;
 use warnings;
-use Storable;
-use Carp;
 
 use base qw/DBIx::Class/;
 
+use Storable qw/nfreeze thaw/;
+use DBIx::Class::Exception;
+use Try::Tiny;
+
+use namespace::clean;
+
 use overload
     # on some RH perls the following line causes serious performance problem
     # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
     q/""/ => sub { __PACKAGE__ . ":" . shift->source_moniker; },
     fallback => 1;
 
-__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker/);
+__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker _detached_source/);
 
 # Schema to use when thawing.
 our $thaw_schema;
 
 =head1 NAME
 
-DBIx::Class::ResultSourceHandle - Decouple Rows/ResultSets objects from their Source objects
+DBIx::Class::ResultSourceHandle - Serializable pointers to ResultSource instances
 
 =head1 DESCRIPTION
 
-This module removes fixed link between Rows/ResultSets and the actual source
-objects, which gets round the following problems
-
-=over 4
-
-=item *
-
-Needing to keep C<$schema> in scope, since any objects/result_sets
-will have a C<$schema> object through their source handle
-
-=item *
+Currently instances of this class are used to allow proper serialization of
+L<ResultSources|DBIx::Class::ResultSource> (which may contain unserializable
+elements like C<CODE> references).
 
-Large output when using Data::Dump(er) since this class can be set to
-stringify to almost nothing
-
-=back
+Originally this module was used to remove the fixed link between
+L<Rows|DBIx::Class::Row>/L<ResultSets|DBIx::Class::ResultSet> and the actual
+L<result source objects|DBIx::Class::ResultSource> in order to obviate the need
+of keeping a L<schema instance|DBIx::Class::Schema> constantly in scope, while
+at the same time avoiding leaks due to circular dependencies. This is however
+no longer needed after introduction of a proper mutual-assured-destruction
+contract between a C<Schema> instance and its C<ResultSource> registrants.
 
 =head1 METHODS
 
@@ -48,11 +47,17 @@ stringify to almost nothing
 =cut
 
 sub new {
-    my ($class, $data) = @_;
+  my ($class, $args) = @_;
+  my $self = bless $args, ref $class || $class;
 
-    $class = ref $class if ref $class;
+  unless( ($self->{schema} || $self->{_detached_source}) && $self->{source_moniker} ) {
+    my $err = 'Expecting a schema instance and a source moniker';
+    $self->{schema}
+      ? $self->{schema}->throw_exception($err)
+      : DBIx::Class::Exception->throw($err)
+  }
 
-    bless $data, $class;
+  $self;
 }
 
 =head2 resolve
@@ -61,7 +66,16 @@ Resolve the moniker into the actual ResultSource object
 
 =cut
 
-sub resolve { return $_[0]->schema->source($_[0]->source_moniker) }
+sub resolve {
+  return $_[0]->{schema}->source($_[0]->source_moniker) if $_[0]->{schema};
+
+  $_[0]->_detached_source || DBIx::Class::Exception->throw( sprintf (
+    # vague error message as this is never supposed to happen
+    "Unable to resolve moniker '%s' - please contact the dev team at %s",
+    $_[0]->source_moniker,
+    'http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT',
+  ), 'full_stacktrace');
+}
 
 =head2 STORABLE_freeze
 
@@ -70,14 +84,18 @@ Freezes a handle.
 =cut
 
 sub STORABLE_freeze {
-    my ($self, $cloning) = @_;
+  my ($self, $cloning) = @_;
 
-    my $to_serialize = { %$self };
+  my $to_serialize = { %$self };
 
-    delete $to_serialize->{schema};
-    $to_serialize->{_frozen_from_class} = $self->schema->class($self->source_moniker);
+  delete $to_serialize->{schema};
+  delete $to_serialize->{_detached_source};
+  $to_serialize->{_frozen_from_class} = $self->{schema}
+    ? $self->{schema}->class($self->source_moniker)
+    : $self->{_detached_source}->result_class
+  ;
 
-    return (Storable::nfreeze($to_serialize));
+  nfreeze($to_serialize);
 }
 
 =head2 STORABLE_thaw
@@ -88,22 +106,31 @@ C<< $schema->thaw($ice) >> which handles this for you.
 
 =cut
 
-
 sub STORABLE_thaw {
-    my ($self, $cloning, $ice) = @_;
-    %$self = %{ Storable::thaw($ice) };
-
-    my $class = delete $self->{_frozen_from_class};
-    if( $thaw_schema ) {
-        $self->{schema} = $thaw_schema;
+  my ($self, $cloning, $ice) = @_;
+  %$self = %{ thaw($ice) };
+
+  my $from_class = delete $self->{_frozen_from_class};
+
+  if( $thaw_schema ) {
+    $self->schema( $thaw_schema );
+  }
+  elsif( my $rs = $from_class->result_source_instance ) {
+    # in the off-chance we are using CDBI-compat and have leaked $schema already
+    if( my $s = try { $rs->schema } ) {
+      $self->schema( $s );
     }
     else {
-        my $rs = $class->result_source_instance;
-        $self->{schema} = $rs->schema if $rs;
+      $rs->source_name( $self->source_moniker );
+      $rs->{_detached_thaw} = 1;
+      $self->_detached_source( $rs );
     }
-
-    carp "Unable to restore schema. Look at 'freeze' and 'thaw' methods in DBIx::Class::Schema."
-        unless $self->{schema};
+  }
+  else {
+    DBIx::Class::Exception->throw(
+      "Thaw failed - original result class '$from_class' does not exist on this system"
+    );
+  }
 }
 
 =head1 AUTHOR
index 1a0297f..8b63593 100644 (file)
@@ -87,11 +87,12 @@ sub table {
     $class->ensure_class_loaded($table_class);
 
     $table = $table_class->new({
-        $class->can('result_source_instance') ?
-          %{$class->result_source_instance||{}} : (),
+        $class->can('result_source_instance')
+          ? %{$class->result_source_instance||{}}
+          : ()
+        ,
         name => $table,
         result_class => $class,
-        source_name => undef,
     });
   }
 
index 5b350bd..a34a1d8 100644 (file)
@@ -162,21 +162,21 @@ sub new {
 
   my $new = bless { _column_data => {} }, $class;
 
-  my $source =
-    delete $attrs->{-result_source}
-      or
-    ( $attrs->{-source_handle} and (delete $attrs->{-source_handle})->resolve )
-  ;
-  $new->result_source($source) if $source;
-
-  if (my $related = delete $attrs->{-cols_from_relations}) {
-    @{$new->{_ignore_at_insert}={}}{@$related} = ();
-  }
-
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
 
+    my $source = delete $attrs->{-result_source};
+    if ( my $h = delete $attrs->{-source_handle} ) {
+      $source ||= $h->resolve;
+    }
+
+    $new->result_source($source) if $source;
+
+    if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
+      @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
+    }
+
     my ($related,$inflated);
 
     foreach my $key (keys %$attrs) {
@@ -1438,8 +1438,8 @@ See L<DBIx::Class::Schema/throw_exception>.
 sub throw_exception {
   my $self=shift;
 
-  if (ref $self && ref $self->result_source && $self->result_source->schema) {
-    $self->result_source->schema->throw_exception(@_)
+  if (ref $self && ref $self->result_source ) {
+    $self->result_source->throw_exception(@_)
   }
   else {
     DBIx::Class::Exception->throw(@_);
index 294c579..1c30436 100644 (file)
@@ -347,7 +347,7 @@ sub _Top {
     ? $requested_order
     : [ map
       { "$rs_attrs->{alias}.$_" }
-      ( $rs_attrs->{_rsroot_source_handle}->resolve->_pri_cols )
+      ( $rs_attrs->{_rsroot_rsrc}->_pri_cols )
     ]
   );
 
@@ -481,7 +481,7 @@ Currently used by B<Sybase ASE>, due to lack of any other option.
 sub _GenericSubQ {
   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 
-  my $root_rsrc = $rs_attrs->{_rsroot_source_handle}->resolve;
+  my $root_rsrc = $rs_attrs->{_rsroot_rsrc};
   my $root_tbl_name = $root_rsrc->name;
 
   # mangle the input sql as we will be replacing the selector
index bceb1b1..7d57aea 100644 (file)
@@ -14,10 +14,6 @@ sub STORABLE_freeze {
     my ($self, $cloning) = @_;
     my $to_serialize = { %$self };
 
-    # The source is either derived from _source_handle or is
-    # reattached in the thaw handler below
-    delete $to_serialize->{result_source};
-
     # Dynamic values, easy to recalculate
     delete $to_serialize->{$_} for qw/related_resultsets _inflated_column/;
 
@@ -28,10 +24,6 @@ sub STORABLE_thaw {
     my ($self, $cloning, $serialized) = @_;
 
     %$self = %{ Storable::thaw($serialized) };
-
-    # if the handle went missing somehow, reattach
-    $self->result_source($self->result_source_instance)
-      if !$self->_source_handle && $self->can('result_source_instance');
 }
 
 1;
index e67d36b..4e2d2b9 100644 (file)
@@ -2025,7 +2025,7 @@ sub _select_args {
     from => $ident,
     where => $where,
     $rs_alias && $alias2source->{$rs_alias}
-      ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
+      ? ( _rsroot_rsrc => $alias2source->{$rs_alias} )
       : ()
     ,
   };
index cbf4626..01b6383 100644 (file)
@@ -156,7 +156,7 @@ sub _adjust_select_args_for_complex_prefetch {
 
     +{
       -alias => $attrs->{alias},
-      -source_handle => $inner_from->[0]{-source_handle},
+      -rsrc => $inner_from->[0]{-rsrc},
       $attrs->{alias} => $subq,
     };
   };
@@ -445,8 +445,8 @@ sub _resolve_ident_sources {
         $tabinfo = $_->[0];
       }
 
-      $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve
-        if ($tabinfo->{-source_handle});
+      $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-rsrc}
+        if ($tabinfo->{-rsrc});
     }
   }
 
index f8cd1c3..e7052d5 100644 (file)
@@ -44,6 +44,7 @@ unless (DBICTest::RunMode->is_plain) {
   require Class::Struct;
   require FileHandle;
   require Hash::Merge;
+  require Storable;
 
   no warnings qw/redefine once/;
   no strict qw/refs/;
@@ -142,9 +143,6 @@ unless (DBICTest::RunMode->is_plain) {
   }
 
   my $base_collection = {
-    schema => $schema,
-    storage => $storage,
-
     resultset => $rs,
 
     # twice so that we make sure only one H::M object spawned
@@ -155,14 +153,24 @@ unless (DBICTest::RunMode->is_plain) {
 
     result_source => $rs->result_source,
 
+    result_source_handle => $rs->result_source->handle,
+
     fresh_pager => $rs->page(5)->pager,
     pager => $pager,
     pager_explicit_count => $pager_explicit_count,
 
-    sql_maker => $storage->sql_maker,
-    dbh => $storage->_dbh
   };
 
+  %$base_collection = (
+    %$base_collection,
+    refrozen => Storable::dclone( $base_collection ),
+    rerefrozen => Storable::dclone( Storable::dclone( $base_collection ) ),
+    schema => $schema,
+    storage => $storage,
+    sql_maker => $storage->sql_maker,
+    dbh => $storage->_dbh,
+  );
+
   memory_cycle_ok ($base_collection, 'No cycles in the object collection')
     if $have_test_cycle;
 
index 630ef8e..0a052b8 100644 (file)
@@ -519,6 +519,45 @@ lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't
 
 }
 
+# make sure that obsolete handle-based source tracking continues to work for the time being
+{
+  my $handle = $schema->source('Artist')->handle;
+
+  my $rowdata = {
+    artistid => 3,
+    charfield => undef,
+    name => "We Are In Rehab",
+    rank => 13
+  };
+
+  my $rs = DBIx::Class::ResultSet->new($handle);
+  my $rs_result = $rs->next;
+  isa_ok( $rs_result, 'DBICTest::Artist' );
+  is_deeply (
+    { $rs_result->get_columns },
+    $rowdata,
+    'Correct columns retrieved (rset/source link healthy)'
+  );
+
+  my $row = DBICTest::Artist->new({ -source_handle => $handle });
+  is_deeply(
+    { $row->get_columns },
+    {},
+    'No columns yet'
+  );
+
+  # store_column to fool the _orig_ident tracker
+  $row->store_column('artistid', $rowdata->{artistid});
+  $row->in_storage(1);
+
+  $row->discard_changes;
+  is_deeply(
+    { $row->get_columns },
+    $rowdata,
+    'Storage refetch successful'
+  );
+}
+
 # make sure we got rid of the compat shims
 SKIP: {
     skip "Remove in 0.082", 3 if $DBIx::Class::VERSION < 0.082;
index 55aa74b..dedf8da 100644 (file)
@@ -151,4 +151,42 @@ for my $name (keys %stores) {
     $schema->storage->debugcb(undef);
 }
 
+# test schema-less detached thaw
+{
+  my $artist = $schema->resultset('Artist')->find(1);
+
+  $artist = dclone $artist;
+
+  is( $artist->name, 'Caterwauler McCrae', 'getting column works' );
+
+  ok( $artist->update, 'Non-dirty update noop' );
+
+  ok( $artist->name( 'Beeeeeeees' ), 'setting works' );
+
+  ok( $artist->is_column_changed( 'name' ), 'Column dirtyness works' );
+  ok( $artist->is_changed, 'object dirtyness works' );
+
+  my $rs = $artist->result_source->resultset;
+  $rs->set_cache([ $artist ]);
+
+  is( $rs->count, 1, 'Synthetic resultset count works' );
+
+  my $exc = qr/Unable to perform storage-dependent operations with a detached result source.+use \$schema->thaw/;
+
+  throws_ok { $artist->update }
+    $exc,
+    'Correct exception on row op'
+  ;
+
+  throws_ok { $artist->discard_changes }
+    $exc,
+    'Correct exception on row op'
+  ;
+
+  throws_ok { $rs->find(1) }
+    $exc,
+    'Correct exception on rs op'
+  ;
+}
+
 done_testing;