X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMultiColumnIn.pm;fp=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMultiColumnIn.pm;h=0000000000000000000000000000000000000000;hb=fe0708a2d68b5d34b6bc6f7e70164c3e569f1dd0;hp=30d7299130bca0606f44ab13b00a41f44fa2fc91;hpb=01272eb81fe3a43e0a2f7befa465cc669945d543;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm b/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm deleted file mode 100644 index 30d7299..0000000 --- a/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm +++ /dev/null @@ -1,62 +0,0 @@ -package DBIx::Class::Storage::DBI::MultiColumnIn; - -use strict; -use warnings; - -use base 'DBIx::Class::Storage::DBI'; -use mro 'c3'; - -=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 overridden 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->_pri_cols; - 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 $sqla = $self->_sql_maker; - my ($sql, @bind) = @${$rs->as_query}; - $sql = sprintf ('(%s) IN %s', # the as_query stuff is already enclosed in ()s - join (', ', map { $sqla->_quote ($_) } @pcols), - $sql, - ); - - return $self->$op ( - $rsrc, - $op eq 'update' ? $values : (), - \[$sql, @bind], - ); - -} - -=head1 AUTHORS - -See L - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - -1;