X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker.pm;h=34b9c80820d055227ba2bd3a76e39fbe2ef7720c;hb=dad42de6afbfc6faa63e9aa726030f22c1aa582a;hp=89053e32cff6101aca393c1ec7bec6ecfb692790;hpb=726c8f65ef37b47aad62e29a306f64528a00f65d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index 89053e3..34b9c80 100644 --- a/lib/DBIx/Class/SQLMaker.pm +++ b/lib/DBIx/Class/SQLMaker.pm @@ -1,5 +1,8 @@ package DBIx::Class::SQLMaker; +use strict; +use warnings; + =head1 NAME DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class @@ -24,10 +27,6 @@ Currently the enhancements to L are: =item * Support of C<...FOR UPDATE> type of select statement modifiers -=item * The -ident operator - -=item * The -value operator - =back =cut @@ -38,8 +37,7 @@ use base qw/ DBIx::Class /; use mro 'c3'; -use strict; -use warnings; + use Sub::Name 'subname'; use DBIx::Class::Carp; use DBIx::Class::Exception; @@ -79,68 +77,24 @@ BEGIN { } # the "oh noes offset/top without limit" constant -# limited to 32 bits for sanity (and consistency, -# since it is ultimately handed to sprintf %u) +# limited to 31 bits for sanity (and consistency, +# since it may be handed to the like of sprintf %u) +# +# Also *some* builds of SQLite fail the test +# some_column BETWEEN ? AND ?: 1, 4294967295 +# with the proper integer bind attrs +# # Implemented as a method, since ::Storage::DBI also # refers to it (i.e. for the case of software_limit or # as the value to abuse with MSSQL ordered subqueries) -sub __max_int { 0xFFFFFFFF }; - -sub new { - my $self = shift->next::method(@_); +sub __max_int () { 0x7FFFFFFF }; - # use the same coderefs, they are prepared to handle both cases - my @extra_dbic_syntax = ( - { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' }, - { regex => qr/^ value $/xi, handler => '_where_op_VALUE' }, +# poor man's de-qualifier +sub _quote { + $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] ) + ? $_[1] =~ / ([^\.]+) $ /x + : $_[1] ); - - push @{$self->{special_ops}}, @extra_dbic_syntax; - push @{$self->{unary_ops}}, @extra_dbic_syntax; - - $self; -} - -sub _where_op_IDENT { - my $self = shift; - my ($op, $rhs) = splice @_, -2; - if (ref $rhs) { - $self->throw_exception("-$op takes a single scalar argument (a quotable identifier)"); - } - - # in case we are called as a top level special op (no '=') - my $lhs = shift; - - $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs); - - return $lhs - ? "$lhs = $rhs" - : $rhs - ; -} - -sub _where_op_VALUE { - my $self = shift; - my ($op, $rhs) = splice @_, -2; - - # in case we are called as a top level special op (no '=') - my $lhs = shift; - - my @bind = [ - ($lhs || $self->{_nested_func_lhs} || $self->throw_exception("Unable to find bindtype for -value $rhs") ), - $rhs - ]; - - return $lhs - ? ( - $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'), - @bind - ) - : ( - $self->_convert('?'), - @bind, - ) - ; } sub _where_op_NEST { @@ -190,7 +144,12 @@ sub select { } ; - $sql = $self->$limiter ($sql, $rs_attrs, $limit, $offset); + $sql = $self->$limiter ( + $sql, + { %{$rs_attrs||{}}, _selector_sql => $fields }, + $limit, + $offset + ); } else { ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs); @@ -209,7 +168,7 @@ sub select { sub _assemble_binds { my $self = shift; - return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/select from where group having order/); + return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/); } my $for_syntax = { @@ -218,7 +177,15 @@ my $for_syntax = { }; sub _lock_select { my ($self, $type) = @_; - my $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); + + my $sql; + if (ref($type) eq 'SCALAR') { + $sql = "FOR $$type"; + } + else { + $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); + } + return " $sql"; } @@ -408,7 +375,9 @@ sub _gen_from_blocks { push(@j, $self->_from_chunk_to_sql($to)); } - push(@j, ' ON ', $self->_join_condition($on)); + my ($sql, @bind) = $self->_join_condition($on); + push(@j, ' ON ', $sql); + push @{$self->{from_bind}}, @bind; push @fchunks, join '', @j; } @@ -419,15 +388,18 @@ sub _gen_from_blocks { sub _from_chunk_to_sql { my ($self, $fromspec) = @_; - return join (' ', $self->_SWITCH_refkind($fromspec, { - SCALARREF => sub { + return join (' ', do { + if (! ref $fromspec) { + $self->_quote($fromspec); + } + elsif (ref $fromspec eq 'SCALAR') { $$fromspec; - }, - ARRAYREFREF => sub { + } + elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') { push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec]; $$fromspec->[0]; - }, - HASHREF => sub { + } + elsif (ref $fromspec eq 'HASH') { my ($as, $table, $toomuch) = ( map { $_ => $fromspec->{$_} } ( grep { $_ !~ /^\-/ } keys %$fromspec ) @@ -437,35 +409,44 @@ sub _from_chunk_to_sql { if defined $toomuch; ($self->_from_chunk_to_sql($table), $self->_quote($as) ); - }, - SCALAR => sub { - $self->_quote($fromspec); - }, - })); + } + else { + $self->throw_exception('Unsupported from refkind: ' . ref $fromspec ); + } + }); } sub _join_condition { my ($self, $cond) = @_; - if (ref $cond eq 'HASH') { - my %j; - for (keys %$cond) { - my $v = $cond->{$_}; - if (ref $v) { - $self->throw_exception (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'}) - if ref($v) ne 'SCALAR'; - $j{$_} = $v; - } - else { - my $x = '= '.$self->_quote($v); $j{$_} = \$x; - } - }; - return scalar($self->_recurse_where(\%j)); - } elsif (ref $cond eq 'ARRAY') { - return join(' OR ', map { $self->_join_condition($_) } @$cond); - } else { - die "Can't handle this yet!"; + # Backcompat for the old days when a plain hashref + # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2 + # Once things settle we should start warning here so that + # folks unroll their hacks + if ( + ref $cond eq 'HASH' + and + keys %$cond == 1 + and + (keys %$cond)[0] =~ /\./ + and + ! ref ( (values %$cond)[0] ) + ) { + $cond = { keys %$cond => { -ident => values %$cond } } } + elsif ( ref $cond eq 'ARRAY' ) { + # do our own ORing so that the hashref-shim above is invoked + my @parts; + my @binds; + foreach my $c (@$cond) { + my ($sql, @bind) = $self->_join_condition($c); + push @binds, @bind; + push @parts, $sql; + } + return join(' OR ', @parts), @binds; + } + + return $self->_recurse_where($cond); } 1;