From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 23 May 2009 19:35:59 +0000 (+0000)
Subject: Add storage component of multipk resultset update/delete for multicolumn IN capable... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ce3b8511e36f3007da96e8926baacc2ed56986c;p=dbsrgits%2FDBIx-Class-Historic.git

Add storage component of multipk resultset update/delete for multicolumn IN capable rdbms
Switch Pg to that (tested via DBICTEST_DSN)
---

diff --git a/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm b/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
new file mode 100644
index 0000000..050c018
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
@@ -0,0 +1,60 @@
+package DBIx::Class::Storage::DBI::MultiColumnIn;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::DBI';
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::MultiColumnIn - Storage component for RDBMS supporting multicolumn in clauses
+
+=head1 DESCRIPTION
+
+While ANSI SQL does not define a multicolumn in operator, many databases can
+in fact understand WHERE (cola, colb) IN ( SELECT subcol_a, subcol_b ... )
+The storage class for any such RDBMS should inherit from this class, in order
+to dramatically speed up update/delete operations on joined multipk resultsets.
+
+At this point the only overriden method is C<_multipk_update_delete()>
+
+=cut
+
+sub _multipk_update_delete {
+  my $self = shift;
+  my ($rs, $op, $values) = @_;
+
+  my $rsrc = $rs->result_source;
+  my @pcols = $rsrc->primary_columns;
+  my $attrs = $rs->_resolved_attrs;
+
+  # naive check - this is an internal method after all, we should know what we are doing 
+  $self->throw_exception ('Number of columns selected by supplied resultset does not match number of primary keys')
+    if ( ref $attrs->{select} ne 'ARRAY' or @{$attrs->{select}} != @pcols );
+
+  # This is hideously ugly, but SQLA does not understand multicol IN expressions
+  my ($sql, @bind) = @${$rs->as_query};
+  $sql = sprintf ('(%s) IN %s',
+    join (', ', @pcols),
+    $sql,
+  );
+
+  return $self->$op (
+    $rsrc,
+    $op eq 'update' ? $values : (),
+    \[$sql, @bind],
+  );
+
+}
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index 5fcaa17..41b2357 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use DBD::Pg qw(:pg_types);
 
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);
 
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index 2cb4be9..7391593 100644
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::mysql;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
 
 # __PACKAGE__->load_components(qw/PK::Auto/);