Merge 'source-handle' into 'DBIx-Class-current'
Matt S Trout [Thu, 28 Dec 2006 19:24:41 +0000 (19:24 +0000)]
13 files changed:
lib/DBIx/Class/Core.pm
lib/DBIx/Class/DB.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/ResultSourceHandle.pm [new file with mode: 0644]
lib/DBIx/Class/ResultSourceProxy.pm
lib/DBIx/Class/ResultSourceProxy/Table.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Serialize/Storable.pm [deleted file]
t/60core.t
t/68inflate.t
t/lib/DBICTest/Schema/ArtistSourceName.pm

index 504480e..92dd74c 100644 (file)
@@ -7,14 +7,12 @@ no warnings 'qw';
 use base qw/DBIx::Class/;
 
 __PACKAGE__->load_components(qw/
-  Serialize::Storable
   Relationship
   InflateColumn
   PK::Auto
   PK
   Row
-  ResultSourceProxy::Table
-  /);
+  ResultSourceProxy::Table/);
 
 1;
 
index e002377..9d80916 100644 (file)
@@ -8,6 +8,7 @@ use DBIx::Class::Schema;
 use DBIx::Class::Storage::DBI;
 use DBIx::Class::ClassResolver::PassThrough;
 use DBI;
+use Scalar::Util;
 
 unless ($INC{"DBIx/Class/CDBICompat.pm"}) {
   warn "IMPORTANT: DBIx::Class::DB is DEPRECATED AND *WILL* BE REMOVED. DO NOT USE.\n";
@@ -140,13 +141,43 @@ native L<DBIx::Class::ResultSet> system.
 =cut
 
 sub resultset_instance {
-  my $class = ref $_[0] || $_[0];
-  my $source = $class->result_source_instance;
+  $_[0]->result_source_instance->resultset
+}
+
+sub result_source_instance {
+  my $class = shift;
+  $class = ref $class || $class;
+  __PACKAGE__->mk_classdata(qw/_result_source_instance/)
+    unless __PACKAGE__->can('_result_source_instance');
+
+  
+  return $class->_result_source_instance(@_) if @_;
+
+  my $source = $class->_result_source_instance;
+  return {} unless Scalar::Util::blessed($source);
+
   if ($source->result_class ne $class) {
-    $source = $source->new($source);
-    $source->result_class($class);
+    # Remove old source instance so we dont get deep recursion
+    #$DB::single = 1;
+    # Need to set it to a non-undef value so that it doesn't just fallback to
+    # a parent class's _result_source_instance
+    #$class->_result_source_instance({});
+    #$class->table($class);
+    #$source = $class->_result_source_instance;
+
+    $DB::single = 1;
+    $source = $source->new({ 
+        %$source, 
+        source_name  => $class,
+        result_class => $class
+    } );
+    $class->_result_source_instance($source);
+    if (my $coderef = $class->can('schema_instance')) {
+        $coderef->($class)->register_class($class, $class);
+    }
   }
-  return $source->resultset;
+  return $source;
 }
 
 =head2 resolve_class
index cf4f89a..e715725 100644 (file)
@@ -10,9 +10,10 @@ use Carp::Clan qw/^DBIx::Class/;
 use Data::Page;
 use Storable;
 use DBIx::Class::ResultSetColumn;
+use DBIx::Class::ResultSourceHandle;
 use base qw/DBIx::Class/;
 
-__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
+__PACKAGE__->mk_group_accessors('simple' => qw/result_class _source_handle/);
 
 =head1 NAME
 
@@ -84,7 +85,8 @@ sub new {
   return $class->new_result(@_) if ref $class;
 
   my ($source, $attrs) = @_;
-  #weaken $source;
+  $source = $source->handle 
+    unless $source->isa('DBIx::Class::ResultSourceHandle');
   $attrs = { %{$attrs||{}} };
 
   if ($attrs->{page}) {
@@ -96,8 +98,8 @@ sub new {
   $attrs->{alias} ||= 'me';
 
   my $self = {
-    result_source => $source,
-    result_class => $attrs->{result_class} || $source->result_class,
+    _source_handle => $source,
+    result_class => $attrs->{result_class} || $source->resolve->result_class,
     cond => $attrs->{where},
     count => undef,
     pager => undef,
@@ -238,7 +240,7 @@ sub search_rs {
         : $having);
   }
 
-  my $rs = (ref $self)->new($self->result_source, $new_attrs);
+  my $rs = (ref $self)->new($self->_source_handle, $new_attrs);
   if ($rows) {
     $rs->set_cache($rows);
   }
@@ -742,7 +744,7 @@ sub next {
 sub _construct_object {
   my ($self, @row) = @_;
   my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
-  my @new = $self->result_class->inflate_result($self->result_source, @$info);
+  my @new = $self->result_class->inflate_result($self->_source_handle, @$info);
   @new = $self->{_attrs}{record_filter}->(@new)
     if exists $self->{_attrs}{record_filter};
   return @new;
@@ -918,7 +920,7 @@ sub _count { # Separated out so pager can get the full count
   # offset, order by and page are not needed to count. record_filter is cdbi
   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
 
-  my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
+  my $tmp_rs = (ref $self)->new($self->_source_handle, $attrs);
   my ($count) = $tmp_rs->cursor->next;
   return $count;
 }
@@ -1229,7 +1231,7 @@ attribute set on the resultset (10 by default).
 
 sub page {
   my ($self, $page) = @_;
-  return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
+  return (ref $self)->new($self->_source_handle, { %{$self->{attrs}}, page => $page });
 }
 
 =head2 new_result
@@ -1259,11 +1261,9 @@ sub new_result {
   my %new = (
     %{ $self->_remove_alias($values, $alias) },
     %{ $self->_remove_alias($collapsed_cond, $alias) },
-    -result_source => $self->result_source,
   );
 
-  my $obj = $self->result_class->new(\%new);
-  return $obj;
+  return $self->result_class->new(\%new,$self->_source_handle);
 }
 
 # _collapse_cond
@@ -1557,7 +1557,7 @@ sub related_resultset {
     my $rel_obj = $self->result_source->relationship_info($rel);
 
     $self->throw_exception(
-      "search_related: result source '" . $self->result_source->name .
+      "search_related: result source '" . $self->_source_handle->source_moniker .
         "' has no such relationship $rel")
       unless $rel_obj;
     
@@ -1566,7 +1566,7 @@ sub related_resultset {
     my $join_count = $seen->{$rel};
     my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
 
-    $self->result_source->schema->resultset($rel_obj->{class})->search_rs(
+    $self->_source_handle->schema->resultset($rel_obj->{class})->search_rs(
       undef, {
         %{$self->{attrs}||{}},
         join => undef,
@@ -1607,7 +1607,7 @@ sub _resolved_attrs {
   return $self->{_attrs} if $self->{_attrs};
 
   my $attrs = { %{$self->{attrs}||{}} };
-  my $source = $self->{result_source};
+  my $source = $self->result_source;
   my $alias = $attrs->{alias};
 
   $attrs->{columns} ||= delete $attrs->{cols} if exists $attrs->{cols};
@@ -1739,6 +1739,16 @@ sub _merge_attr {
   }
 }
 
+sub result_source {
+    my $self = shift;
+
+    if (@_) {
+        $self->_source_handle($_[0]->handle);
+    } else {
+        $self->_source_handle->resolve;
+    }
+}
+
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/throw_exception> for details.
@@ -1747,7 +1757,7 @@ See L<DBIx::Class::Schema/throw_exception> for details.
 
 sub throw_exception {
   my $self=shift;
-  $self->result_source->schema->throw_exception(@_);
+  $self->_source_handle->schema->throw_exception(@_);
 }
 
 # XXX: FIXME: Attributes docs need clearing up
index d89454a..e3c2b80 100644 (file)
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use DBIx::Class::ResultSet;
+use DBIx::Class::ResultSourceHandle;
 use Carp::Clan qw/^DBIx::Class/;
 use Storable;
 
@@ -11,12 +12,13 @@ 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_name
-  source_info/);
+  schema from _relationships column_info_from_storage source_info/);
 
 __PACKAGE__->mk_group_accessors('inherited' => qw/resultset_class
   result_class/);
 
+__PACKAGE__->mk_group_ro_accessors('simple' => qw/source_name/);
+
 =head1 NAME
 
 DBIx::Class::ResultSource - Result source object
@@ -991,6 +993,20 @@ its class name.
   # from your schema...
   $schema->resultset('Books')->find(1);
 
+=head2 handle
+
+Obtain a new handle to this source. Returns an instance of a 
+L<DBIx::Class::ResultSourceHandle>.
+
+=cut
+
+sub handle {
+    return new DBIx::Class::ResultSourceHandle({
+        schema         => $_[0]->schema,
+        source_moniker => $_[0]->source_name
+    });
+}
+
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/"throw_exception">.
diff --git a/lib/DBIx/Class/ResultSourceHandle.pm b/lib/DBIx/Class/ResultSourceHandle.pm
new file mode 100644 (file)
index 0000000..60118b8
--- /dev/null
@@ -0,0 +1,76 @@
+package DBIx::Class::ResultSourceHandle;
+
+use strict;
+use warnings;
+use Storable;
+
+use base qw/DBIx::Class/;
+
+use overload
+    q/""/ => sub { __PACKAGE__ . ":" . shift->source_moniker; },
+    fallback => 1;
+
+__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker/);
+
+=head1 NAME
+
+DBIx::Class::ResultSourceHandle
+
+=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 *
+
+Large output when using Data::Dump(er) since this class can be set to
+stringify to almost nothing
+
+=item *
+
+Closer to being aboe to do a Serialize::Storable that doesn't require class-based connections
+
+=back
+
+=head1 METHODS
+
+=head2 new
+
+=cut
+
+sub new {
+    my ($class, $data) = @_;
+
+    $class = ref $class if ref $class;
+
+    bless $data, $class;
+}
+
+=head2 resolve
+
+Resolve the moniker into the actual ResultSource object
+
+=cut
+
+sub resolve { return $_[0]->schema->source($_[0]->source_moniker) }
+
+sub STORABLE_freeze {
+    my ($self, $cloning) = @_;
+    my $to_serialize = { %$self };
+    delete $to_serialize->{schema};
+    return (Storable::freeze($to_serialize));
+}
+
+sub STORABLE_thaw {
+    my ($self, $cloning,$ice) = @_;
+    %$self = %{ Storable::thaw($ice) };
+}
+
+1;
index b596e5c..696c9a5 100644 (file)
@@ -5,13 +5,29 @@ use strict;
 use warnings;
 
 use base qw/DBIx::Class/;
+use Scalar::Util qw/blessed/;
+use Carp::Clan qw/^DBIx::Class/;
 
 sub iterator_class  { shift->result_source_instance->resultset_class(@_) }
 sub resultset_class { shift->result_source_instance->resultset_class(@_) }
 sub result_class { shift->result_source_instance->result_class(@_) }
-sub source_name { shift->result_source_instance->source_name(@_) }
 sub source_info { shift->result_source_instance->source_info(@_) }
 
+sub set_inherited_ro_instance {
+    my $self = shift;
+
+    croak "Cannot set @{[shift]} on an instance" if blessed $self;
+
+    return $self->set_inherited(@_);
+}
+
+sub get_inherited_ro_instance {
+    return shift->get_inherited(@_);
+}
+
+__PACKAGE__->mk_group_accessors('inherited_ro_instance' => 'source_name');
+
+
 sub resultset_attributes {
   shift->result_source_instance->resultset_attributes(@_);
 }
index 0816dd7..ce78cb8 100644 (file)
@@ -53,7 +53,12 @@ sub table {
         source_name => undef,
     });
   }
-  $class->mk_classdata('result_source_instance' => $table);
+
+  $class->mk_classdata('result_source_instance')
+    unless $class->can('result_source_instance');
+
+  $class->result_source_instance($table);
+
   if ($class->can('schema_instance')) {
     $class =~ m/([^:]+)$/;
     $class->schema_instance->register_class($class, $class);
index bd59293..8360f37 100644 (file)
@@ -6,7 +6,7 @@ use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 
-__PACKAGE__->mk_group_accessors('simple' => 'result_source');
+__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
 =head1 NAME
 
@@ -30,18 +30,17 @@ Creates a new row object from column => value mappings passed as a hash ref
 =cut
 
 sub new {
-  my ($class, $attrs) = @_;
+  my ($class, $attrs, $source) = @_;
   $class = ref $class if ref $class;
 
   my $new = { _column_data => {} };
   bless $new, $class;
 
+  $new->_source_handle($source) if $source;
+
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
-    if (my $source = delete $attrs->{-result_source}) {
-      $new->result_source($source);
-    }
     
     my ($related,$inflated);
     foreach my $key (keys %$attrs) {
@@ -65,6 +64,10 @@ sub new {
         unless $class->has_column($key);
       $new->store_column($key => $attrs->{$key});          
     }
+    if (my $source = delete $attrs->{-result_source}) {
+      $new->result_source($source);
+    }
+
     $new->{_relationship_data} = $related if $related;
     $new->{_inflated_column} = $inflated if $inflated;
   }
@@ -87,9 +90,9 @@ L<DBIx::Class::ResultSet/create>).
 sub insert {
   my ($self) = @_;
   return $self if $self->in_storage;
-  $self->{result_source} ||= $self->result_source_instance
+  my $source = $self->result_source;
+  $source ||=  $self->result_source($self->result_source_instance)
     if $self->can('result_source_instance');
-  my $source = $self->{result_source};
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
   #use Data::Dumper; warn Dumper($self);
@@ -379,9 +382,17 @@ Called by ResultSet to inflate a result from storage
 
 sub inflate_result {
   my ($class, $source, $me, $prefetch) = @_;
-  #use Data::Dumper; print Dumper(@_);
+
+  my ($source_handle) = $source;
+
+  if ($source->isa('DBIx::Class::ResultSourceHandle')) {
+      $source = $source_handle->resolve
+  } else {
+      $source_handle = $source->handle
+  }
+
   my $new = {
-    result_source => $source,
+    _source_handle => $source_handle,
     _column_data => $me,
     _in_storage => 1
   };
@@ -481,6 +492,18 @@ sub is_column_changed {
 
 Accessor to the ResultSource this object was created from
 
+=cut
+
+sub result_source {
+    my $self = shift;
+
+    if (@_) {
+        $self->_source_handle($_[0]->handle);
+    } else {
+        $self->_source_handle->resolve;
+    }
+}
+
 =head2 register_column
 
   $column_info = { .... };
index 1bcd5b3..3981b51 100644 (file)
@@ -94,10 +94,15 @@ moniker.
 
 sub register_source {
   my ($self, $moniker, $source) = @_;
+
+  %$source = %{ $source->new( { %$source, source_name => $moniker }) };
+
   my %reg = %{$self->source_registrations};
   $reg{$moniker} = $source;
   $self->source_registrations(\%reg);
+
   $source->schema($self);
+
   weaken($source->{schema}) if ref($self);
   if ($source->result_class) {
     my %map = %{$self->class_mappings};
@@ -106,6 +111,19 @@ sub register_source {
   }
 }
 
+sub _unregister_source {
+    my ($self, $moniker) = @_;
+    my %reg = %{$self->source_registrations}; 
+
+    my $source = delete $reg{$moniker};
+    $self->source_registrations(\%reg);
+    if ($source->result_class) {
+        my %map = %{$self->class_mappings};
+        delete $map{$source->result_class};
+        $self->class_mappings(\%map);
+    }
+}
+
 =head2 class
 
 =over 4
@@ -276,9 +294,10 @@ sub load_classes {
           }
         }
         $class->ensure_class_loaded($comp_class);
-        $comp_class->source_name($comp) unless $comp_class->source_name;
 
-        push(@to_register, [ $comp_class->source_name, $comp_class ]);
+        $comp = $comp_class->source_name || $comp;
+#  $DB::single = 1;
+        push(@to_register, [ $comp, $comp_class ]);
       }
     }
   }
diff --git a/lib/DBIx/Class/Serialize/Storable.pm b/lib/DBIx/Class/Serialize/Storable.pm
deleted file mode 100644 (file)
index 7ccd2b0..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-package DBIx::Class::Serialize::Storable;
-use strict;
-use warnings;
-use Storable;
-
-sub STORABLE_freeze {
-    my ($self,$cloning) = @_;
-    my $to_serialize = { %$self };
-    delete $to_serialize->{result_source};
-    return (Storable::freeze($to_serialize));
-}
-
-sub STORABLE_thaw {
-    my ($self,$cloning,$serialized) = @_;
-    %$self = %{ Storable::thaw($serialized) };
-    $self->result_source($self->result_source_instance)
-      if $self->can('result_source_instance');
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-    DBIx::Class::Serialize::Storable - hooks for Storable freeze/thaw
-
-=head1 SYNOPSIS
-
-    # in a table class definition
-    __PACKAGE__->load_components(qw/Serialize::Storable/);
-
-    # meanwhile, in a nearby piece of code
-    my $cd = $schema->resultset('CD')->find(12);
-    # if the cache uses Storable, this will work automatically
-    $cache->set($cd->ID, $cd);
-
-=head1 DESCRIPTION
-
-This component adds hooks for Storable so that row objects can be
-serialized. It assumes that your row object class (C<result_class>) is
-the same as your table class, which is the normal situation.
-
-=head1 HOOKS
-
-The following hooks are defined for L<Storable> - see the
-documentation for L<Storable/Hooks> for detailed information on these
-hooks.
-
-=head2 STORABLE_freeze
-
-The serializing hook, called on the object during serialization. It
-can be inherited, or defined in the class itself, like any other
-method.
-
-=head2 STORABLE_thaw
-
-The deserializing hook called on the object during deserialization.
-
-=head1 AUTHORS
-
-David Kamholz <dkamholz@cpan.org>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
index b0d7ec6..3eb80df 100644 (file)
@@ -255,7 +255,7 @@ ok($schema->storage(), 'Storage available');
   cmp_ok(@artsn, '==', 4, "Four artists returned");
   
   # make sure subclasses that don't set source_name are ok
-  ok($schema->source('ArtistSubclass', 'ArtistSubclass exists'));
+  ok($schema->source('ArtistSubclass'), 'ArtistSubclass exists');
 }
 
 my $newbook = $schema->resultset( 'Bookmark' )->find(1);
index 0ce901c..7afb0e9 100644 (file)
@@ -5,7 +5,6 @@ use Test::More;
 use lib qw(t/lib);
 use DBICTest;
 
-DBICTest::Schema::CD->add_column('year');
 my $schema = DBICTest->init_schema();
 
 eval { require DateTime };
@@ -13,7 +12,9 @@ plan skip_all => "Need DateTime for inflation tests" if $@;
 
 plan tests => 4;
 
-DBICTest::Schema::CD->inflate_column( 'year',
+$schema->class('CD')
+#DBICTest::Schema::CD
+->inflate_column( 'year',
     { inflate => sub { DateTime->new( year => shift ) },
       deflate => sub { shift->year } }
 );
index c4c8a8b..c59bbe5 100644 (file)
@@ -2,7 +2,7 @@ package # hide from PAUSE
     DBICTest::Schema::ArtistSourceName;
 
 use base 'DBICTest::Schema::Artist';
-
+__PACKAGE__->table(__PACKAGE__->table);
 __PACKAGE__->source_name('SourceNameArtists');
 
 1;