X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker.pm;h=14fbb291ddf1c6cd90bd05ebab093075884963ed;hb=d71502b;hp=34b9c80820d055227ba2bd3a76e39fbe2ef7720c;hpb=8d47598dd975df026f838ff5e54f583c34fc6662;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index 34b9c80..14fbb29 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 @@ -89,6 +85,10 @@ BEGIN { # as the value to abuse with MSSQL ordered subqueries) sub __max_int () { 0x7FFFFFFF }; +# we ne longer need to check this - DBIC has ways of dealing with it +# specifically ::Storage::DBI::_resolve_bindattrs() +sub _assert_bindval_matches_bindtype () { 1 }; + # poor man's de-qualifier sub _quote { $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] ) @@ -133,16 +133,25 @@ sub select { ($sql, @bind) = $self->next::method ($table, $fields, $where); - my $limiter = - $self->can ('emulate_limit') # also backcompat hook from SQLA::Limit - || - do { - my $dialect = $self->limit_dialect - or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found" ); - $self->can ("_$dialect") - or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); - } - ; + my $limiter; + + if( $limiter = $self->can ('emulate_limit') ) { + carp_unique( + 'Support for the legacy emulate_limit() mechanism inherited from ' + . 'SQL::Abstract::Limit has been deprecated, and will be removed when ' + . 'DBIC transitions to Data::Query. If your code uses this type of ' + . 'limit specification please file an RT and provide the source of ' + . 'your emulate_limit() implementation, so an acceptable upgrade-path ' + . 'can be devised' + ); + } + else { + my $dialect = $self->limit_dialect + or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" ); + + $limiter = $self->can ("_$dialect") + or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); + } $sql = $self->$limiter ( $sql, @@ -314,6 +323,18 @@ sub _order_by { } } +sub _split_order_chunk { + my ($self, $chunk) = @_; + + # strip off sort modifiers, but always succeed, so $1 gets reset + $chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix; + + return ( + $chunk, + ( $1 and uc($1) eq 'DESC' ) ? 1 : 0, + ); +} + sub _table { # optimized due to hotttnesss # my ($self, $from) = @_; @@ -346,7 +367,6 @@ sub _generate_join_clause { sub _recurse_from { my $self = shift; - return join (' ', $self->_gen_from_blocks(@_) ); } @@ -449,6 +469,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