[Bast-commits] r6382 - DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-05-23 19:35:59 +0000 (Sat, 23 May 2009)
New Revision: 6382

Added:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm
Log:
Add storage component of multipk resultset update/delete for multicolumn IN capable rdbms
Switch Pg to that (tested via DBICTEST_DSN)

Added: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm	                        (rev 0)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm	2009-05-23 19:35:59 UTC (rev 6382)
@@ -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;

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm	2009-05-23 19:33:28 UTC (rev 6381)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm	2009-05-23 19:35:59 UTC (rev 6382)
@@ -5,7 +5,7 @@
 
 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/);
 

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm	2009-05-23 19:33:28 UTC (rev 6381)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm	2009-05-23 19:35:59 UTC (rev 6382)
@@ -3,7 +3,7 @@
 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/);