X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker.pm;h=1162280b60c8a3c9147bbec4da11319f51b65e4c;hb=fcf32d045;hp=b45fd68a49a5863274e6fe28b164d3270e260161;hpb=67341081b1a57cc8549e51a8fb1b8cd4661543c5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index b45fd68..1162280 100644 --- a/lib/DBIx/Class/SQLMaker.pm +++ b/lib/DBIx/Class/SQLMaker.pm @@ -40,7 +40,6 @@ use mro 'c3'; use Sub::Name 'subname'; use DBIx::Class::Carp; -use DBIx::Class::Exception; use namespace::clean; __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/); @@ -71,9 +70,6 @@ BEGIN { my($func) = (caller(1))[3]; __PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_)); }; - - # Current SQLA pollutes its namespace - clean for the time being - namespace::clean->clean_subroutines(qw/SQL::Abstract carp croak confess/); } # the "oh noes offset/top without limit" constant @@ -458,6 +454,55 @@ sub _join_condition { return $self->_recurse_where($cond); } +# This is hideously ugly, but SQLA does not understand multicol IN expressions +# FIXME TEMPORARY - DQ should have native syntax for this +# moved here to raise API questions +# +# !!! EXPERIMENTAL API !!! WILL CHANGE !!! +sub _where_op_multicolumn_in { + my ($self, $lhs, $rhs) = @_; + + if (! ref $lhs or ref $lhs eq 'ARRAY') { + my (@sql, @bind); + for (ref $lhs ? @$lhs : $lhs) { + if (! ref $_) { + push @sql, $self->_quote($_); + } + elsif (ref $_ eq 'SCALAR') { + push @sql, $$_; + } + elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') { + my ($s, @b) = @$$_; + push @sql, $s; + push @bind, @b; + } + else { + $self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs..."); + } + } + $lhs = \[ join(', ', @sql), @bind]; + } + elsif (ref $lhs eq 'SCALAR') { + $lhs = \[ $$lhs ]; + } + elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) { + # noop + } + else { + $self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs..."); + } + + # is this proper...? + $rhs = \[ $self->_recurse_where($rhs) ]; + + for ($lhs, $rhs) { + $$_->[0] = "( $$_->[0] )" + unless $$_->[0] =~ /^ \s* \( .* \) \s* ^/xs; + } + + \[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ]; +} + 1; =head1 AUTHORS