Fix stupid oversight in update_all

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

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index c4520f3..b12fca7 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -8,6 +8,7 @@ use DBIx::Class::Exception;
 use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken/;
 use Try::Tiny;
+use Test::Deep::NoTest 'eq_deeply';
 
 # not importing first() as it will clash with our own method
 use List::Util ();
@@ -86,7 +87,7 @@ another.
   sub get_data {
     my $self = shift;
     my $request = $self->get_request; # Get a request object somehow.
-    my $schema = $self->get_schema;   # Get the DBIC schema object somehow.
+    my $schema = $self->result_source->schema;
 
     my $cd_rs = $schema->resultset('CD')->search({
       title => $request->param('title'),
@@ -251,7 +252,8 @@ call it as C<search(undef, \%attrs)>.
 For a list of attributes that can be passed to C<search>, see
 L</ATTRIBUTES>. For more examples of using this function, see
 L<Searching|DBIx::Class::Manual::Cookbook/Searching>. For a complete
-documentation for the first argument, see L<SQL::Abstract>.
+documentation for the first argument, see L<SQL::Abstract>
+and its extension L<DBIx::Class::SQLMaker>.
 
 For more help on using joins with search, see L<DBIx::Class::Manual::Joining>.
 
@@ -528,17 +530,61 @@ sub _normalize_selection {
 
 sub _stack_cond {
   my ($self, $left, $right) = @_;
+
+  # collapse single element top-level conditions
+  # (single pass only, unlikely to need recursion)
+  for ($left, $right) {
+    if (ref $_ eq 'ARRAY') {
+      if (@$_ == 0) {
+        $_ = undef;
+      }
+      elsif (@$_ == 1) {
+        $_ = $_->[0];
+      }
+    }
+    elsif (ref $_ eq 'HASH') {
+      my ($first, $more) = keys %$_;
+
+      # empty hash
+      if (! defined $first) {
+        $_ = undef;
+      }
+      # one element hash
+      elsif (! defined $more) {
+        if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
+          $_ = $_->{'-and'};
+        }
+        elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
+          $_ = $_->{'-or'};
+        }
+      }
+    }
+  }
+
+  # merge hashes with weeding out of duplicates (simple cases only)
+  if (ref $left eq 'HASH' and ref $right eq 'HASH') {
+
+    # shallow copy to destroy
+    $right = { %$right };
+    for (grep { exists $right->{$_} } keys %$left) {
+      # the use of eq_deeply here is justified - the rhs of an
+      # expression can contain a lot of twisted weird stuff
+      delete $right->{$_} if eq_deeply( $left->{$_}, $right->{$_} );
+    }
+
+    $right = undef unless keys %$right;
+  }
+
+
   if (defined $left xor defined $right) {
     return defined $left ? $left : $right;
   }
-  elsif (defined $left) {
-    return { -and => [ map
-      { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-      ($left, $right)
-    ]};
+  elsif (! defined $left) {
+    return undef;
+  }
+  else {
+    return { -and => [ $left, $right ] };
   }
-
-  return undef;
 }
 
 =head2 search_literal
@@ -1654,12 +1700,8 @@ sub _rs_update_delete {
 
   my $rsrc = $self->result_source;
 
-  # if a condition exists we need to strip all table qualifiers
-  # if this is not possible we'll force a subquery below
-  my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
-
   my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
-  my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/);
+  my $needs_subq = $needs_group_by_subq || $self->_has_resolved_attr(qw/rows offset/);
 
   if ($needs_group_by_subq or $needs_subq) {
 
@@ -1704,10 +1746,23 @@ sub _rs_update_delete {
     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};
+
     return $rsrc->storage->$op(
       $rsrc,
       $op eq 'update' ? $values : (),
-      $cond,
+      $self->{cond} ? \[$sql, @bind] : (),
     );
   }
 }
@@ -1775,7 +1830,7 @@ sub update_all {
     unless ref $values eq 'HASH';
 
   my $guard = $self->result_source->schema->txn_scope_guard;
-  $_->update($values) for $self->all;
+  $_->update({%$values}) for $self->all;  # shallow copy - update will mangle it
   $guard->commit;
   return 1;
 }