X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=c51c45d5f096a40fd9692e939283e300c08e243d;hb=3b0202245e84a09a41ac31a13b80547a300a227e;hp=204d3be5fc2ee01f79734dbe3a39a6c7040645e0;hpb=e04535201f33f1d9c6222106a218944cf9eb3dbe;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 204d3be..c51c45d 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -3,25 +3,25 @@ package DBIx::Class::ResultSource;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
-
-use DBIx::Class::ResultSet;
-use DBIx::Class::ResultSourceHandle;
+use base 'DBIx::Class::ResultSource::RowParser';
+use mro 'c3';
 
 use DBIx::Class::Carp;
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
-use Try::Tiny;
 use Scalar::Util qw/blessed weaken isweak/;
 
+# FIXME - somehow breaks ResultSetManager, do not remove until investigated
+use DBIx::Class::ResultSet;
+
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => qw/
   source_name name source_info
   _ordered_columns _columns _primaries _unique_constraints
   _relationships resultset_attributes
-  column_info_from_storage
+  column_info_from_storage sqlt_deploy_callback
 /);
 
 __PACKAGE__->mk_group_accessors(component_class => qw/
@@ -29,8 +29,6 @@ __PACKAGE__->mk_group_accessors(component_class => qw/
   result_class
 /);
 
-__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
-
 =head1 NAME
 
 DBIx::Class::ResultSource - Result source object
@@ -130,6 +128,7 @@ sub new {
   $new->{_relationships} = { %{$new->{_relationships}||{}} };
   $new->{name} ||= "!!NAME NOT SET!!";
   $new->{_columns_info_loaded} ||= 0;
+  $new->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
   return $new;
 }
 
@@ -354,7 +353,10 @@ sub add_columns {
   return $self;
 }
 
-sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
+sub add_column {
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  shift->add_columns(@_)
+}
 
 =head2 has_column
 
@@ -403,12 +405,12 @@ sub column_info {
   if ( ! $self->_columns->{$column}{data_type}
        and ! $self->{_columns_info_loaded}
        and $self->column_info_from_storage
-       and my $stor = try { $self->storage } )
+       and my $stor = dbic_internal_try { $self->schema->storage } )
   {
     $self->{_columns_info_loaded}++;
 
     # try for the case of storage without table
-    try {
+    dbic_internal_try {
       my $info = $stor->columns_info_for( $self->from );
       my $lc_info = { map
         { (lc $_) => $info->{$_} }
@@ -481,12 +483,12 @@ sub columns_info {
       and
     grep { ! $_->{data_type} } values %$colinfo
       and
-    my $stor = try { $self->storage }
+    my $stor = dbic_internal_try { $self->schema->storage }
   ) {
     $self->{_columns_info_loaded}++;
 
     # try for the case of storage without table
-    try {
+    dbic_internal_try {
       my $info = $stor->columns_info_for( $self->from );
       my $lc_info = { map
         { (lc $_) => $info->{$_} }
@@ -579,7 +581,10 @@ sub remove_columns {
   $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
 }
 
-sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
+sub remove_column {
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  shift->remove_columns(@_)
+}
 
 =head2 set_primary_key
 
@@ -799,6 +804,8 @@ See also L</add_unique_constraint>.
 =cut
 
 sub add_unique_constraints {
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+
   my $self = shift;
   my @constraints = @_;
 
@@ -939,11 +946,11 @@ sub unique_constraint_columns {
 
 =back
 
-  __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
+  __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod');
 
    or
 
-  __PACKAGE__->sqlt_deploy_callback(sub {
+  __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub {
     my ($source_instance, $sqlt_table) = @_;
     ...
   } );
@@ -1130,7 +1137,7 @@ sub resultset {
   $self->resultset_class->new(
     $self,
     {
-      try { %{$self->schema->default_resultset_attributes} },
+      ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
       %{$self->{resultset_attributes}},
     },
   );
@@ -1255,7 +1262,10 @@ Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
 
 =cut
 
-sub storage { shift->schema->storage; }
+sub storage {
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+  $_[0]->schema->storage
+}
 
 =head2 add_relationship
 
@@ -1378,7 +1388,7 @@ Returns all relationship names for this source.
 =cut
 
 sub relationships {
-  return keys %{shift->_relationships};
+  keys %{$_[0]->_relationships};
 }
 
 =head2 relationship_info
@@ -1471,7 +1481,7 @@ sub reverse_relationship_info {
     # to use the source_names, otherwise we will use the actual classes
 
     # the schema may be partial
-    my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
+    my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
       or next;
 
     if ($registered_source_name) {
@@ -1560,7 +1570,7 @@ sub _minimal_valueset_satisfying_constraint {
 
   $args->{columns_info} ||= $self->columns_info;
 
-  my $vals = $self->storage->_extract_fixed_condition_columns(
+  my $vals = $self->schema->storage->_extract_fixed_condition_columns(
     $args->{values},
     ($args->{carp_on_nulls} ? 'consider_nulls' : undef ),
   );
@@ -1649,7 +1659,7 @@ sub _resolve_join {
       $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
 
       # the actual seen value will be incremented by the recursion
-      my $as = $self->storage->relname_to_table_alias(
+      my $as = $self->schema->storage->relname_to_table_alias(
         $rel, ($seen->{$rel} && $seen->{$rel} + 1)
       );
 
@@ -1668,7 +1678,7 @@ sub _resolve_join {
   }
   else {
     my $count = ++$seen->{$join};
-    my $as = $self->storage->relname_to_table_alias(
+    my $as = $self->schema->storage->relname_to_table_alias(
       $join, ($count > 1 && $count)
     );
 
@@ -2269,7 +2279,7 @@ sub related_source {
   # if we are not registered with a schema - just use the prototype
   # however if we do have a schema - ask for the source by name (and
   # throw in the process if all fails)
-  if (my $schema = try { $self->schema }) {
+  if (my $schema = dbic_internal_try { $self->schema }) {
     $schema->source($self->relationship_info($rel)->{source});
   }
   else {
@@ -2319,6 +2329,7 @@ relationship definitions.
 =cut
 
 sub handle {
+  require DBIx::Class::ResultSourceHandle;
   return DBIx::Class::ResultSourceHandle->new({
     source_moniker => $_[0]->source_name,
 
@@ -2359,6 +2370,7 @@ sub DESTROY {
   # which will serve as a signal to not try doing anything else
   # however beware - on older perls the exception seems randomly untrappable
   # due to some weird race condition during thread joining :(((
+  local $SIG{__DIE__} if $SIG{__DIE__};
   local $@;
   eval {
     weaken $_[0]->{schema};
@@ -2366,10 +2378,15 @@ sub DESTROY {
     # if schema is still there reintroduce ourselves with strong refs back to us
     if ($_[0]->{schema}) {
       my $srcregs = $_[0]->{schema}->source_registrations;
-      for (keys %$srcregs) {
-        next unless $srcregs->{$_};
-        $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
-      }
+
+      defined $srcregs->{$_}
+        and
+      $srcregs->{$_} == $_[0]
+        and
+      $srcregs->{$_} = $_[0]
+        and
+      last
+        for keys %$srcregs;
     }
 
     1;
@@ -2377,7 +2394,10 @@ sub DESTROY {
     $global_phase_destroy = 1;
   };
 
-  return;
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }