X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=d2cc10f6a615ee9e54d9afdaba923853daf76484;hb=d009cb7d393292037eff527a9f8bab93860224fb;hp=c80ffc40ac28cc886953b091509e5cc6bafd562b;hpb=ab78b111dca3bb783456be05aaf807cf44f1173a;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index c80ffc4..d2cc10f 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -3,17 +3,15 @@ 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';
+__PACKAGE__->load_components(qw(
+  ResultSource::RowParser
+));
 
 use DBIx::Class::Carp;
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try );
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
-use Try::Tiny;
-use List::Util 'first';
 use Scalar::Util qw/blessed weaken isweak/;
 
 use namespace::clean;
@@ -404,12 +402,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->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->{$_} }
@@ -476,18 +474,18 @@ sub columns_info {
   my $colinfo = $self->_columns;
 
   if (
-    first { ! $_->{data_type} } values %$colinfo
-      and
     ! $self->{_columns_info_loaded}
       and
     $self->column_info_from_storage
       and
-    my $stor = try { $self->storage }
+    grep { ! $_->{data_type} } values %$colinfo
+      and
+    my $stor = dbic_internal_try { $self->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->{$_} }
@@ -803,7 +801,7 @@ sub add_unique_constraints {
   my $self = shift;
   my @constraints = @_;
 
-  if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
+  if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
     # with constraint name
     while (my ($name, $constraint) = splice @constraints, 0, 2) {
       $self->add_unique_constraint($name => $constraint);
@@ -1131,7 +1129,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}},
     },
   );
@@ -1360,29 +1358,6 @@ sub add_relationship {
   $self->_relationships(\%rels);
 
   return $self;
-
-# XXX disabled. doesn't work properly currently. skip in tests.
-
-  my $f_source = $self->schema->source($f_source_name);
-  unless ($f_source) {
-    $self->ensure_class_loaded($f_source_name);
-    $f_source = $f_source_name->result_source;
-    #my $s_class = ref($self->schema);
-    #$f_source_name =~ m/^${s_class}::(.*)$/;
-    #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
-    #$f_source = $self->schema->source($f_source_name);
-  }
-  return unless $f_source; # Can't test rel without f_source
-
-  try { $self->_resolve_join($rel, 'me', {}, []) }
-  catch {
-    # If the resolve failed, back out and re-throw the error
-    delete $rels{$rel};
-    $self->_relationships(\%rels);
-    $self->throw_exception("Error creating relationship $rel: $_");
-  };
-
-  1;
 }
 
 =head2 relationships
@@ -1495,7 +1470,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) {
@@ -1708,9 +1683,11 @@ sub _resolve_join {
                 ,
                -join_path => [@$jpath, { $join => $as } ],
                -is_single => (
-                  (! $rel_info->{attrs}{accessor})
+                  ! $rel_info->{attrs}{accessor}
+                    or
+                  $rel_info->{attrs}{accessor} eq 'single'
                     or
-                  first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
+                  $rel_info->{attrs}{accessor} eq 'filter'
                 ),
                -alias => $as,
                -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
@@ -2291,7 +2268,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 {
@@ -2341,6 +2318,7 @@ relationship definitions.
 =cut
 
 sub handle {
+  require DBIx::Class::ResultSourceHandle;
   return DBIx::Class::ResultSourceHandle->new({
     source_moniker => $_[0]->source_name,
 
@@ -2381,6 +2359,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};
@@ -2388,10 +2367,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;
@@ -2399,7 +2383,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) }