take more care in mangling SELECT when applying subquery limits

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / SQLMaker.pm

diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index 89053e3..c4bd627 100644 (file)
--- 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,9 +27,9 @@ Currently the enhancements to L<SQL::Abstract> are:
 
 =item * Support of C<...FOR UPDATE> type of select statement modifiers
 
-=item * The -ident operator
+=item * The L</-ident> operator
 
-=item * The -value operator
+=item * The L</-value> operator
 
 =back
 
@@ -38,8 +41,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,12 +81,25 @@ 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 __max_int () { 0x7FFFFFFF };
+
+# poor man's de-qualifier
+sub _quote {
+  $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
+    ? $_[1] =~ / ([^\.]+) $ /x
+    : $_[1]
+  );
+}
 
 sub new {
   my $self = shift->next::method(@_);
@@ -190,7 +205,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 +229,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/select from where group having order limit/);
 }
 
 my $for_syntax = {
@@ -408,7 +428,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;
   }
@@ -447,29 +469,73 @@ sub _from_chunk_to_sql {
 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;
 
+=head1 OPERATORS
+
+=head2 -ident
+
+Used to explicitly specify an SQL identifier. Takes a plain string as value
+which is then invariably treated as a column name (and is being properly
+quoted if quoting has been requested). Most useful for comparison of two
+columns:
+
+    my %where = (
+        priority => { '<', 2 },
+        requestor => { -ident => 'submitter' }
+    );
+
+which results in:
+
+    $stmt = 'WHERE "priority" < ? AND "requestor" = "submitter"';
+    @bind = ('2');
+
+=head2 -value
+
+The -value operator signals that the argument to the right is a raw bind value.
+It will be passed straight to DBI, without invoking any of the SQL::Abstract
+condition-parsing logic. This allows you to, for example, pass an array as a
+column value for databases that support array datatypes, e.g.:
+
+    my %where = (
+        array => { -value => [1, 2, 3] }
+    );
+
+which results in:
+
+    $stmt = 'WHERE array = ?';
+    @bind = ([1, 2, 3]);
+
 =head1 AUTHORS
 
 See L<DBIx::Class/CONTRIBUTORS>.