Fold column_info() into columns_info()

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 4ebb4c0..a8da52e 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -9,7 +9,7 @@ use DBIx::Class::Carp;
 use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
-use Scalar::Util qw/blessed weaken isweak/;
+use Scalar::Util qw( blessed weaken isweak refaddr );
 
 # FIXME - somehow breaks ResultSetManager, do not remove until investigated
 use DBIx::Class::ResultSet;
@@ -122,11 +122,23 @@ Creates a new ResultSource object.  Not normally called directly by end users.
 =cut
 
 {
+  my $rsrc_registry;
+
+  sub __derived_instances {
+    map {
+      (defined $_->{weakref})
+        ? $_->{weakref}
+        : ()
+    } values %{ $rsrc_registry->{ refaddr($_[0]) }{ derivatives } }
+  }
+
   sub new {
     my ($class, $attrs) = @_;
     $class = ref $class if ref $class;
 
-    my $self = bless { %{$attrs || {}} }, $class;
+    my $ancestor = delete $attrs->{__derived_from};
+
+    my $self = bless { %$attrs }, $class;
 
 
     DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
@@ -149,6 +161,39 @@ Creates a new ResultSource object.  Not normally called directly by end users.
     Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
 
 
+    my $own_slot = $rsrc_registry->{
+      my $own_addr = refaddr $self
+    } = { derivatives => {} };
+
+    weaken( $own_slot->{weakref} = $self );
+
+    if(
+      length ref $ancestor
+        and
+      my $ancestor_slot = $rsrc_registry->{
+        my $ancestor_addr = refaddr $ancestor
+      }
+    ) {
+
+      # on ancestry recording compact registry slots, prevent unbound growth
+      for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
+        defined $r->{$_}{weakref} or delete $r->{$_}
+          for keys %$r;
+      }
+
+      weaken( $_->{$own_addr} = $own_slot ) for map
+        { $_->{derivatives} }
+        (
+          $ancestor_slot,
+          (grep
+            { defined $_->{derivatives}{$ancestor_addr} }
+            values %$rsrc_registry
+          ),
+        )
+      ;
+    }
+
+
     $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
     $self->{name} ||= "!!NAME NOT SET!!";
     $self->{_columns_info_loaded} ||= 0;
@@ -162,6 +207,16 @@ Creates a new ResultSource object.  Not normally called directly by end users.
 
     $self;
   }
+
+  sub DBIx::Class::__Rsrc_Ancestry_iThreads_handler__::CLONE {
+    for my $r ( $rsrc_registry, map { $_->{derivatives} } values %$rsrc_registry ) {
+      %$r = map {
+        defined $_->{weakref}
+          ? ( refaddr $_->{weakref} => $_ )
+          : ()
+      } values %$r
+    }
+  }
 }
 
 =head2 clone
@@ -179,7 +234,7 @@ sub clone {
   $self->new({
     (
       (length ref $self)
-        ? %$self
+        ? ( %$self, __derived_from => $self )
         : ()
     ),
     (
@@ -390,13 +445,19 @@ sub add_columns {
   my ($self, @cols) = @_;
   $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
 
-  my @added;
+  my ( @added, $colinfos );
   my $columns = $self->_columns;
+
   while (my $col = shift @cols) {
-    my $column_info = {};
-    if ($col =~ s/^\+//) {
-      $column_info = $self->column_info($col);
-    }
+    my $column_info =
+      (
+        $col =~ s/^\+//
+          and
+        ( $colinfos ||= $self->columns_info )->{$col}
+      )
+        ||
+      {}
+    ;
 
     # If next entry is { ... } use that for the column info, if not
     # use an empty hashref
@@ -407,6 +468,7 @@ sub add_columns {
     push(@added, $col) unless exists $columns->{$col};
     $columns->{$col} = $column_info;
   }
+
   push @{ $self->_ordered_columns }, @added;
   return $self;
 }
@@ -456,35 +518,10 @@ contents of the hashref.
 =cut
 
 sub column_info {
-  my ($self, $column) = @_;
-  $self->throw_exception("No such column $column")
-    unless exists $self->_columns->{$column};
-
-  if ( ! $self->_columns->{$column}{data_type}
-       and ! $self->{_columns_info_loaded}
-       and $self->column_info_from_storage
-       and my $stor = dbic_internal_try { $self->schema->storage } )
-  {
-    $self->{_columns_info_loaded}++;
-
-    # try for the case of storage without table
-    dbic_internal_try {
-      my $info = $stor->columns_info_for( $self->from );
-      my $lc_info = { map
-        { (lc $_) => $info->{$_} }
-        ( keys %$info )
-      };
-
-      foreach my $col ( keys %{$self->_columns} ) {
-        $self->_columns->{$col} = {
-          %{ $self->_columns->{$col} },
-          %{ $info->{$col} || $lc_info->{lc $col} || {} }
-        };
-      }
-    };
-  }
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
-  return $self->_columns->{$column};
+  #my ($self, $column) = @_;
+  $_[0]->columns_info([ $_[1] ])->{$_[1]};
 }
 
 =head2 columns
@@ -579,6 +616,8 @@ sub columns_info {
     }
   }
   else {
+    # the shallow copy is crucial - there are exists() checks within
+    # the wider codebase
     %ret = %$colinfo;
   }
 
@@ -1802,14 +1841,17 @@ sub _pk_depends_on {
   # auto-increment
   my $rel_source = $self->related_source($rel_name);
 
+  my $colinfos;
+
   foreach my $p ($self->primary_columns) {
-    if (exists $keyhash->{$p}) {
-      unless (defined($rel_data->{$keyhash->{$p}})
-              || $rel_source->column_info($keyhash->{$p})
-                            ->{is_auto_increment}) {
-        return 0;
-      }
-    }
+    return 0 if (
+      exists $keyhash->{$p}
+        and
+      ! defined( $rel_data->{$keyhash->{$p}} )
+        and
+      ! ( $colinfos ||= $rel_source->columns_info )
+         ->{$keyhash->{$p}}{is_auto_increment}
+    )
   }
 
   return 1;