Protect DBIC as best we can from the failure mode in 7cb35852

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

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index c80ffc4..03231c7 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -9,11 +9,9 @@ use DBIx::Class::ResultSet;
 use DBIx::Class::ResultSourceHandle;
 
 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 {