Trailing WS crusade - got to save them bits

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index 583045c..8272496 100644 (file)
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -4,7 +4,7 @@ package   #hide from PAUSE
 #
 # This module contains code that should never have seen the light of day,
 # does not belong in the Storage, or is otherwise unfit for public
-# display. The arrival of SQLA2 should immediately oboslete 90% of this
+# display. The arrival of SQLA2 should immediately obsolete 90% of this
 #
 
 use strict;
@@ -15,6 +15,7 @@ use mro 'c3';
 
 use List::Util 'first';
 use Scalar::Util 'blessed';
+use Sub::Name 'subname';
 use namespace::clean;
 
 #
@@ -60,7 +61,7 @@ sub _prune_unused_joins {
 
 #
 # This is the code producing joined subqueries like:
-# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ... 
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
 #
 sub _adjust_select_args_for_complex_prefetch {
   my ($self, $from, $select, $where, $attrs) = @_;
@@ -568,7 +569,7 @@ sub _inner_join_to_node {
   # So it looks like we will have to switch some stuff around.
   # local() is useless here as we will be leaving the scope
   # anyway, and deep cloning is just too fucking expensive
-  # So replace the first hashref in the node arrayref manually 
+  # So replace the first hashref in the node arrayref manually
   my @new_from = ($from->[0]);
   my $sw_idx = { map { (values %$_), 1 } @$switch_branch }; #there's one k/v per join-path
 
@@ -591,64 +592,59 @@ sub _inner_join_to_node {
   return \@new_from;
 }
 
-# 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 introspect the condition
-# and remove all column qualifiers. If it bails out early (returns undef)
-# the calling code should try another approach (e.g. a subquery)
-
-sub _strip_cond_qualifiers_from_array {
-  my ($self, $where) = @_;
-  my @cond;
-  for (my $i = 0; $i < @$where; $i++) {
-    my $entry = $where->[$i];
-    my $hash;
-    my $ref = ref $entry;
-    if ($ref eq 'HASH' or $ref eq 'ARRAY') {
-      $hash = $self->_strip_cond_qualifiers($entry);
-    }
-    elsif (! $ref) {
-      $entry =~ /([^.]+)$/;
-      $hash->{$1} = $where->[++$i];
-    }
-    push @cond, $hash;
-  }
-  return \@cond;
-}
-
-sub _strip_cond_qualifiers {
-  my ($self, $where) = @_;
-
-  my $cond = {};
-
-  # No-op. No condition, we're updating/deleting everything
-  return $cond unless $where;
-
-  if (ref $where eq 'ARRAY') {
-    $cond = $self->_strip_cond_qualifiers_from_array($where);
-  }
-  elsif (ref $where eq 'HASH') {
-    if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
-      $cond->{-and} =
-        $self->_strip_cond_qualifiers_from_array($where->{-and});
-    }
-    else {
-      foreach my $key (keys %$where) {
-        if ($key eq '-or' && ref $where->{$key} eq 'ARRAY') {
-          $cond->{$key} = $self->_strip_cond_qualifiers($where->{$key});
+# yet another atrocity: attempt to extract all columns from a
+# where condition by hooking _quote
+sub _extract_condition_columns {
+  my ($self, $cond, $sql_maker) = @_;
+
+  return [] unless $cond;
+
+  $sql_maker ||= $self->{_sql_ident_capturer} ||= do {
+    # FIXME - replace with a Moo trait
+    my $orig_sm_class = ref $self->sql_maker;
+    my $smic_class = "${orig_sm_class}::_IdentCapture_";
+
+    unless ($smic_class->isa('SQL::Abstract')) {
+
+      no strict 'refs';
+      *{"${smic_class}::_quote"} = subname "${smic_class}::_quote" => sub {
+        my ($self, $ident) = @_;
+        if (ref $ident eq 'SCALAR') {
+          $ident = $$ident;
+          my $storage_quotes = $self->sql_quote_char || '"';
+          my ($ql, $qr) = map
+            { quotemeta $_ }
+            (ref $storage_quotes eq 'ARRAY' ? @$storage_quotes : ($storage_quotes) x 2 )
+          ;
+
+          while ($ident =~ /
+            $ql (\w+) $qr
+              |
+            ([\w\.]+)
+          /xg) {
+            $self->{_captured_idents}{$1||$2}++;
+          }
         }
         else {
-          $key =~ /([^.]+)$/;
-          $cond->{$1} = $where->{$key};
+          $self->{_captured_idents}{$ident}++;
         }
-      }
+        return $ident;
+      };
+
+      *{"${smic_class}::_get_captured_idents"} = subname "${smic_class}::_get_captures" => sub {
+        (delete shift->{_captured_idents}) || {};
+      };
+
+      $self->inject_base ($smic_class, $orig_sm_class);
+
     }
-  }
-  else {
-    return undef;
-  }
 
-  return $cond;
+    $smic_class->new();
+  };
+
+  $sql_maker->_recurse_where($cond);
+
+  return [ sort keys %{$sql_maker->_get_captured_idents} ];
 }
 
 sub _extract_order_criteria {