Port replicated storage from MXAH to native traits.

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

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index e11a8e9..405041c 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -14,6 +14,7 @@ use DBIx::Class::Storage::Statistics;
 use Scalar::Util();
 use List::Util();
 use Data::Dumper::Concise();
+use Sub::Name ();
 
 # what version of sqlt do we require if deploy() without a ddl_dir is invoked
 # when changing also adjust the corresponding author_require in Makefile.PL
@@ -63,7 +64,7 @@ for my $meth (@rdbms_specific_methods) {
 
   no strict qw/refs/;
   no warnings qw/redefine/;
-  *{__PACKAGE__ ."::$meth"} = sub {
+  *{__PACKAGE__ ."::$meth"} = Sub::Name::subname $meth => sub {
     if (not $_[0]->_driver_determined) {
       $_[0]->_determine_driver;
       goto $_[0]->can($meth);
@@ -1565,62 +1566,6 @@ sub delete {
   return $self->_execute('delete' => [], $source, $bind_attrs, @args);
 }
 
-# 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 {
-  my ($self, $where) = @_;
-
-  my $cond = {};
-
-  # No-op. No condition, we're updating/deleting everything
-  return $cond unless $where;
-
-  if (ref $where eq 'ARRAY') {
-    $cond = [
-      map {
-        my %hash;
-        foreach my $key (keys %{$_}) {
-          $key =~ /([^.]+)$/;
-          $hash{$1} = $_->{$key};
-        }
-        \%hash;
-      } @$where
-    ];
-  }
-  elsif (ref $where eq 'HASH') {
-    if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
-      $cond->{-and} = [];
-      my @cond = @{$where->{-and}};
-       for (my $i = 0; $i < @cond; $i++) {
-        my $entry = $cond[$i];
-        my $hash;
-        if (ref $entry eq 'HASH') {
-          $hash = $self->_strip_cond_qualifiers($entry);
-        }
-        else {
-          $entry =~ /([^.]+)$/;
-          $hash->{$1} = $cond[++$i];
-        }
-        push @{$cond->{-and}}, $hash;
-      }
-    }
-    else {
-      foreach my $key (keys %$where) {
-        $key =~ /([^.]+)$/;
-        $cond->{$1} = $where->{$key};
-      }
-    }
-  }
-  else {
-    return undef;
-  }
-
-  return $cond;
-}
-
 # We were sent here because the $rs contains a complex search
 # which will require a subquery to select the correct rows
 # (i.e. joined or limited resultsets, or non-introspectable conditions)
@@ -1634,7 +1579,29 @@ sub _subq_update_delete {
 
   my $rsrc = $rs->result_source;
 
+  # quick check if we got a sane rs on our hands
   my @pcols = $rsrc->primary_columns;
+  unless (@pcols) {
+    $self->throw_exception (
+      sprintf (
+        "You must declare primary key(s) on source '%s' (via set_primary_key) in order to update or delete complex resultsets",
+        $rsrc->source_name || $rsrc->from
+      )
+    );
+  }
+
+  my $sel = $rs->_resolved_attrs->{select};
+  $sel = [ $sel ] unless ref $sel eq 'ARRAY';
+
+  if (
+      join ("\x00", map { join '.', $rs->{attrs}{alias}, $_ } sort @pcols)
+        ne
+      join ("\x00", sort @$sel )
+  ) {
+    $self->throw_exception (
+      '_subq_update_delete can not be called on resultsets selecting columns other than the primary keys'
+    );
+  }
 
   if (@pcols == 1) {
     return $self->$op (
@@ -1806,12 +1773,52 @@ sub _select_args {
   if (
     ( $attrs->{rows} && keys %{$attrs->{collapse}} )
        ||
-    ( $attrs->{group_by} && @{$attrs->{group_by}} &&
-      $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+    ( $attrs->{group_by}
+        &&
+      @{$attrs->{group_by}}
+        &&
+      $attrs->{_prefetch_select}
+        &&
+      @{$attrs->{_prefetch_select}}
+    )
   ) {
+
     ($ident, $select, $where, $attrs)
       = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
   }
+
+  elsif (
+    ($attrs->{rows} || $attrs->{offset})
+      &&
+    $sql_maker->limit_dialect eq 'RowNumberOver'
+      &&
+    (ref $ident eq 'ARRAY' && @$ident > 1)  # indicates a join
+      &&
+    scalar $sql_maker->_order_by_chunks ($attrs->{order_by})
+  ) {
+    # the RNO limit dialect above mangles the SQL such that the join gets lost
+    # wrap a subquery here
+
+    push @limit, delete @{$attrs}{qw/rows offset/};
+
+    my $subq = $self->_select_args_to_query (
+      $ident,
+      $select,
+      $where,
+      $attrs,
+    );
+
+    $ident = {
+      -alias => $attrs->{alias},
+      -source_handle => $ident->[0]{-source_handle},
+      $attrs->{alias} => $subq,
+    };
+
+    # all part of the subquery now
+    delete @{$attrs}{qw/order_by group_by having/};
+    $where = undef;
+  }
+
   elsif (! $attrs->{software_limit} ) {
     push @limit, $attrs->{rows}, $attrs->{offset};
   }
@@ -2033,7 +2040,7 @@ sub last_insert_id {
 
 This API is B<EXPERIMENTAL>, will almost definitely change in the future, and
 currently only used by L<::AutoCast|DBIx::Class::Storage::DBI::AutoCast> and
-L<::Sybase|DBIx::Class::Storage::DBI::Sybase>.
+L<::Sybase::ASE|DBIx::Class::Storage::DBI::Sybase::ASE>.
 
 The default implementation returns C<undef>, implement in your Storage driver if
 you need this functionality.
@@ -2366,10 +2373,19 @@ sub deployment_statements {
     data => $schema,
   );
 
-  my $ret = $tr->translate
-    or $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error);
+  my @ret;
+  my $wa = wantarray;
+  if ($wa) {
+    @ret = $tr->translate;
+  }
+  else {
+    $ret[0] = $tr->translate;
+  }
+
+  $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
+    unless (@ret && defined $ret[0]);
 
-  return $ret;
+  return $wa ? @ret : $ret[0];
 }
 
 sub deploy {