Remove some accumulated cruft

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

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index b1f3360..5c862e3 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -6,7 +6,6 @@ use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Exception;
 use Data::Page;
-use Storable;
 use DBIx::Class::ResultSetColumn;
 use DBIx::Class::ResultSourceHandle;
 use Hash::Merge ();
@@ -31,7 +30,7 @@ use overload
         'bool'   => "_bool",
         fallback => 1;
 
-__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
+__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
 
 =head1 NAME
 
@@ -197,8 +196,8 @@ sub new {
   return $class->new_result(@_) if ref $class;
 
   my ($source, $attrs) = @_;
-  $source = $source->handle
-    unless $source->isa('DBIx::Class::ResultSourceHandle');
+  $source = $source->resolve
+    if $source->isa('DBIx::Class::ResultSourceHandle');
   $attrs = { %{$attrs||{}} };
 
   if ($attrs->{page}) {
@@ -207,22 +206,18 @@ sub new {
 
   $attrs->{alias} ||= 'me';
 
-  # Creation of {} and bless separated to mitigate RH perl bug
-  # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
-  my $self = {
-    _source_handle => $source,
+  my $self = bless {
+    result_source => $source,
     cond => $attrs->{where},
     pager => undef,
-    attrs => $attrs
-  };
-
-  bless $self, $class;
+    attrs => $attrs,
+  }, $class;
 
   $self->result_class(
-    $attrs->{result_class} || $source->resolve->result_class
+    $attrs->{result_class} || $source->result_class
   );
 
-  return $self;
+  $self;
 }
 
 =head2 search
@@ -526,7 +521,7 @@ sub _normalize_selection {
       # if balanced - treat as a columns entry
       $attrs->{"${pref}columns"} = $self->_merge_attr(
         $attrs->{"${pref}columns"},
-        { map { $as->[$_] => $sel->[$_] } ( 0 .. $#$as ) }
+        [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ]
       );
     }
     else {
@@ -1908,21 +1903,24 @@ sub populate {
       push(@created, $self->create($item));
     }
     return wantarray ? @created : \@created;
-  } else {
+  } 
+  else {
     my $first = $data->[0];
 
     # if a column is a registered relationship, and is a non-blessed hash/array, consider
     # it relationship data
     my (@rels, @columns);
+    my $rsrc = $self->result_source;
+    my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
     for (keys %$first) {
       my $ref = ref $first->{$_};
-      $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH')
+      $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
         ? push @rels, $_
         : push @columns, $_
       ;
     }
 
-    my @pks = $self->result_source->primary_columns;
+    my @pks = $rsrc->primary_columns;
 
     ## do the belongs_to relationships
     foreach my $index (0..$#$data) {
@@ -1940,9 +1938,9 @@ sub populate {
       foreach my $rel (@rels) {
         next unless ref $data->[$index]->{$rel} eq "HASH";
         my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
-        my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
+        my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
         my $related = $result->result_source->_resolve_condition(
-          $result->result_source->relationship_info($reverse)->{cond},
+          $reverse_relinfo->{cond},
           $self,
           $result,
         );
@@ -1961,8 +1959,8 @@ sub populate {
     my @inherit_data = values %$rs_data;
 
     ## do bulk insert on current row
-    $self->result_source->storage->insert_bulk(
-      $self->result_source,
+    $rsrc->storage->insert_bulk(
+      $rsrc,
       [@columns, @inherit_cols],
       [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
     );
@@ -1970,18 +1968,19 @@ sub populate {
     ## do the has_many relationships
     foreach my $item (@$data) {
 
+      my $main_row;
+
       foreach my $rel (@rels) {
         next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
 
-        my $parent = $self->find({map { $_ => $item->{$_} } @pks})
-     || $self->throw_exception('Cannot find the relating object.');
+        $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
 
-        my $child = $parent->$rel;
+        my $child = $main_row->$rel;
 
         my $related = $child->result_source->_resolve_condition(
-          $parent->result_source->relationship_info($rel)->{cond},
+          $rels->{$rel}{cond},
           $child,
-          $parent,
+          $main_row,
         );
 
         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
@@ -2274,7 +2273,6 @@ sub new_result {
     @$cols_from_relations
       ? (-cols_from_relations => $cols_from_relations)
       : (),
-    -source_handle => $self->_source_handle,
     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
   );
 
@@ -3088,8 +3086,8 @@ sub as_subselect_rs {
   return $fresh_rs->search( {}, {
     from => [{
       $attrs->{alias} => $self->as_query,
-      -alias         => $attrs->{alias},
-      -source_handle => $self->result_source->handle,
+      -alias  => $attrs->{alias},
+      -rsrc   => $self->result_source,
     }],
     alias => $attrs->{alias},
   });
@@ -3139,8 +3137,8 @@ sub _chain_relationship {
     );
 
     $from = [{
-      -source_handle => $source->handle,
-      -alias => $attrs->{alias},
+      -rsrc   => $source,
+      -alias  => $attrs->{alias},
       $attrs->{alias} => $rs_copy->as_query,
     }];
     delete @{$attrs}{@force_subq_attrs, qw/where bind/};
@@ -3151,7 +3149,7 @@ sub _chain_relationship {
   }
   else {
     $from = [{
-      -source_handle => $source->handle,
+      -rsrc  => $source,
       -alias => $attrs->{alias},
       $attrs->{alias} => $source->from,
     }];
@@ -3231,18 +3229,18 @@ sub _resolved_attrs {
 
   # disassemble columns
   my (@sel, @as);
-  for my $c (@{
-    ref $attrs->{columns} eq 'ARRAY' ? $attrs->{columns} : [ $attrs->{columns} || () ]
-  }) {
-    if (ref $c eq 'HASH') {
-      for my $as (keys %$c) {
-        push @sel, $c->{$as};
-        push @as, $as;
+  if (my $cols = delete $attrs->{columns}) {
+    for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
+      if (ref $c eq 'HASH') {
+        for my $as (keys %$c) {
+          push @sel, $c->{$as};
+          push @as, $as;
+        }
+      }
+      else {
+        push @sel, $c;
+        push @as, $c;
       }
-    }
-    else {
-      push @sel, $c;
-      push @as, $c;
     }
   }
 
@@ -3290,8 +3288,8 @@ sub _resolved_attrs {
   $attrs->{as} = \@as;
 
   $attrs->{from} ||= [{
-    -source_handle => $source->handle,
-    -alias => $self->{attrs}{alias},
+    -rsrc   => $source,
+    -alias  => $self->{attrs}{alias},
     $self->{attrs}{alias} => $source->from,
   }];
 
@@ -3611,17 +3609,6 @@ sub _merge_joinpref_attr {
   }
 }
 
-sub result_source {
-    my $self = shift;
-
-    if (@_) {
-        $self->_source_handle($_[0]->handle);
-    } else {
-        $self->_source_handle->resolve;
-    }
-}
-
-
 sub STORABLE_freeze {
   my ($self, $cloning) = @_;
   my $to_serialize = { %$self };
@@ -3629,7 +3616,7 @@ sub STORABLE_freeze {
   # A cursor in progress can't be serialized (and would make little sense anyway)
   delete $to_serialize->{cursor};
 
-  return nfreeze($to_serialize);
+  nfreeze($to_serialize);
 }
 
 # need this hook for symmetry
@@ -3638,7 +3625,7 @@ sub STORABLE_thaw {
 
   %$self = %{ thaw($serialized) };
 
-  return $self;
+  $self;
 }
 
 
@@ -3651,8 +3638,8 @@ See L<DBIx::Class::Schema/throw_exception> for details.
 sub throw_exception {
   my $self=shift;
 
-  if (ref $self && $self->_source_handle->schema) {
-    $self->_source_handle->schema->throw_exception(@_)
+  if (ref $self and my $rsrc = $self->result_source) {
+    $rsrc->throw_exception(@_)
   }
   else {
     DBIx::Class::Exception->throw(@_);