Majorly cleanup $rs->update/delete (no $rs-aware code should be in ::Storages)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 551427d..c8c89c5 100644 (file)
@@ -1737,35 +1737,116 @@ sub first {
 sub _rs_update_delete {
   my ($self, $op, $values) = @_;
 
+  my $cond = $self->{cond};
   my $rsrc = $self->result_source;
+  my $storage = $rsrc->schema->storage;
+
+  my $attrs = { %{$self->_resolved_attrs} };
+
+  # "needs" is a strong word here - if the subquery is part of an IN clause - no point of
+  # even adding the group_by. It will really be used only when composing a poor-man's
+  # multicolumn-IN equivalent OR set
+  my $needs_group_by_subq = defined $attrs->{group_by};
+
+  # simplify the joinmap and maybe decide if a grouping (and thus subquery) is necessary
+  my $relation_classifications;
+  if (ref($attrs->{from}) eq 'ARRAY') {
+    $attrs->{from} = $storage->_prune_unused_joins ($attrs->{from}, $attrs->{select}, $cond, $attrs);
+
+    $relation_classifications = $storage->_resolve_aliastypes_from_select_args (
+      [ @{$attrs->{from}}[1 .. $#{$attrs->{from}}] ],
+      $attrs->{select},
+      $cond,
+      $attrs
+    ) unless $needs_group_by_subq;  # we already know we need a group, no point of resolving them
+  }
+  else {
+    $needs_group_by_subq ||= 1; # if {from} is unparseable assume the worst
+  }
 
-  my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
-  my $needs_subq = $needs_group_by_subq || $self->_has_resolved_attr(qw/rows offset/);
+  $needs_group_by_subq ||= exists $relation_classifications->{multiplying};
 
-  if ($needs_group_by_subq or $needs_subq) {
+  # if no subquery - life is easy-ish
+  unless (
+    $needs_group_by_subq
+      or
+    keys %$relation_classifications # if any joins at all - need to wrap a subq
+      or
+    $self->_has_resolved_attr(qw/rows offset/) # limits call for a subq
+  ) {
+    # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
+    # a condition containing 'me' or other table prefixes will not work
+    # at all. What this code tries to do (badly) is to generate a condition
+    # with the qualifiers removed, by exploiting the quote mechanism of sqla
+    #
+    # this is atrocious and should be replaced by normal sqla introspection
+    # one sunny day
+    my ($sql, @bind) = do {
+      my $sqla = $rsrc->storage->sql_maker;
+      local $sqla->{_dequalify_idents} = 1;
+      $sqla->_recurse_where($self->{cond});
+    } if $self->{cond};
+
+    return $rsrc->storage->$op(
+      $rsrc,
+      $op eq 'update' ? $values : (),
+      $self->{cond} ? \[$sql, @bind] : (),
+    );
+  }
 
-    # make a new $rs selecting only the PKs (that's all we really need)
-    my $attrs = $self->_resolved_attrs_copy;
+  # we got this far - means it is time to wrap a subquery
+  my $pcols = [ $rsrc->_pri_cols ];
+  my $existing_group_by = delete $attrs->{group_by};
 
+  # make a new $rs selecting only the PKs (that's all we really need for the subq)
+  delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/;
+  $attrs->{columns} = [ map { "$attrs->{alias}.$_" } @$pcols ];
+  $attrs->{group_by} = \ '';  # FIXME - this is an evil hack, it causes the optimiser to kick in and throw away the LEFT joins
+  my $subrs = (ref $self)->new($rsrc, $attrs);
 
-    delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_selector_range as/;
-    $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
+  if (@$pcols == 1) {
+    return $storage->$op (
+      $rsrc,
+      $op eq 'update' ? $values : (),
+      { $pcols->[0] => { -in => $subrs->as_query } },
+    );
+  }
+  elsif ($storage->_use_multicolumn_in) {
+    # This is hideously ugly, but SQLA does not understand multicol IN expressions
+    my $sql_maker = $storage->sql_maker;
+    my ($sql, @bind) = @${$subrs->as_query};
+    $sql = sprintf ('(%s) IN %s', # the as_query already comes with a set of parenthesis
+      join (', ', map { $sql_maker->_quote ($_) } @$pcols),
+      $sql,
+    );
 
+    return $storage->$op (
+      $rsrc,
+      $op eq 'update' ? $values : (),
+      \[$sql, @bind],
+    );
+  }
+  else {
+    # if all else fails - get all primary keys and operate over a ORed set
+    # wrap in a transaction for consistency
+    # this is where the group_by starts to matter
+    my $subq_group_by;
     if ($needs_group_by_subq) {
-      # make sure no group_by was supplied, or if there is one - make sure it matches
-      # the columns compiled above perfectly. Anything else can not be sanely executed
-      # on most databases so croak right then and there
+      $subq_group_by = $attrs->{columns};
 
-      if (my $g = $attrs->{group_by}) {
+      # make sure if there is a supplied group_by it matches the columns compiled above
+      # perfectly. Anything else can not be sanely executed on most databases so croak
+      # right then and there
+      if ($existing_group_by) {
         my @current_group_by = map
           { $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
-          @$g
+          @$existing_group_by
         ;
 
         if (
           join ("\x00", sort @current_group_by)
             ne
-          join ("\x00", sort @{$attrs->{columns}} )
+          join ("\x00", sort @$subq_group_by )
         ) {
           $self->throw_exception (
             "You have just attempted a $op operation on a resultset which does group_by"
@@ -1776,33 +1857,27 @@ sub _rs_update_delete {
           );
         }
       }
-      else {
-        $attrs->{group_by} = $attrs->{columns};
-      }
     }
 
-    my $subrs = (ref $self)->new($rsrc, $attrs);
-    return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
-  }
-  else {
-    # Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
-    # a condition containing 'me' or other table prefixes will not work
-    # at all. What this code tries to do (badly) is to generate a condition
-    # with the qualifiers removed, by exploiting the quote mechanism of sqla
-    #
-    # this is atrocious and should be replaced by normal sqla introspection
-    # one sunny day
-    my ($sql, @bind) = do {
-      my $sqla = $rsrc->storage->sql_maker;
-      local $sqla->{_dequalify_idents} = 1;
-      $sqla->_recurse_where($self->{cond});
-    } if $self->{cond};
+    my $guard = $storage->txn_scope_guard;
 
-    return $rsrc->storage->$op(
+    my @op_condition;
+    for my $row ($subrs->search({}, { group_by => $subq_group_by })->cursor->all) {
+      push @op_condition, { map
+        { $pcols->[$_] => $row->[$_] }
+        (0 .. $#$pcols)
+      };
+    }
+
+    my $res = $storage->$op (
       $rsrc,
       $op eq 'update' ? $values : (),
-      $self->{cond} ? \[$sql, @bind] : (),
+      \@op_condition,
     );
+
+    $guard->commit;
+
+    return $res;
   }
 }