Remove dead code commented out since 2006 ( 953a18ef )

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

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 1b97e22..204d3be 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -13,7 +13,6 @@ use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
 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;
@@ -476,12 +475,12 @@ 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
+    grep { ! $_->{data_type} } values %$colinfo
+      and
     my $stor = try { $self->storage }
   ) {
     $self->{_columns_info_loaded}++;
@@ -803,7 +802,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);
@@ -1360,29 +1359,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
@@ -1708,9 +1684,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,
@@ -1924,10 +1902,15 @@ sub _resolve_relationship_condition {
   ;
 
   my $rel_rsrc = $self->related_source($args->{rel_name});
+  my $storage = $self->schema->storage;
 
   if (exists $args->{foreign_values}) {
 
-    if (defined blessed $args->{foreign_values}) {
+    if (! defined $args->{foreign_values} ) {
+      # fallback: undef => {}
+      $args->{foreign_values} = {};
+    }
+    elsif (defined blessed $args->{foreign_values}) {
 
       $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
         unless $args->{foreign_values}->isa('DBIx::Class::Row');
@@ -1940,12 +1923,41 @@ sub _resolve_relationship_condition {
 
       $args->{foreign_values} = { $args->{foreign_values}->get_columns };
     }
-    elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
-      my $ri = { map { $_ => 1 } $rel_rsrc->relationships };
-      my $ci = $rel_rsrc->columns_info;
-      ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception(
-        "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
-      ) for keys %{ $args->{foreign_values} ||= {} };
+    elsif ( ref $args->{foreign_values} eq 'HASH' ) {
+
+      # re-build {foreign_values} excluding identically named rels
+      if( keys %{$args->{foreign_values}} ) {
+
+        my ($col_idx, $rel_idx) = map
+          { { map { $_ => 1 } $rel_rsrc->$_ } }
+          qw( columns relationships )
+        ;
+
+        my $equivalencies = $storage->_extract_fixed_condition_columns(
+          $args->{foreign_values},
+          'consider nulls',
+        );
+
+        $args->{foreign_values} = { map {
+          # skip if relationship *and* a non-literal ref
+          # this means a multicreate stub was passed in
+          (
+            $rel_idx->{$_}
+              and
+            length ref $args->{foreign_values}{$_}
+              and
+            ! is_literal_value($args->{foreign_values}{$_})
+          )
+            ? ()
+            : ( $_ => (
+                ! $col_idx->{$_}
+                  ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
+              : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
+                  ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
+              : $args->{foreign_values}{$_}
+            ))
+        } keys %{$args->{foreign_values}} };
+      }
     }
     else {
       $self->throw_exception(
@@ -2011,7 +2023,7 @@ sub _resolve_relationship_condition {
       exists $fq_col_list->{$_} or $self->throw_exception (
         "The join-free condition returned for $exception_rel_id may only "
       . 'contain keys that are fully qualified column names of the corresponding source '
-      . "(it returned '$_')"
+      . "'$joinfree_alias' (instead it returned '$_')"
       ) for keys %$jfc;
 
       (
@@ -2117,13 +2129,18 @@ sub _resolve_relationship_condition {
     $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
   }
 
-  $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
+  if (
     $args->{require_join_free_condition}
       and
     ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
-  );
-
-  my $storage = $self->schema->storage;
+  ) {
+    $self->throw_exception(
+      ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
+        exists $args->{foreign_values}
+          ? "'foreign_values'-based reversed-"
+          : ''
+    );
+  }
 
   # we got something back - sanity check and infer values if we can
   my @nonvalues;