Tighten up select list processing in ::SQLMaker

Optimize some of the codepaths (do not recurse in spots where it makes no
practical difference).

Deprecate searches with no explicit select-list ( can't remove it outright due
to downstream breakage :/ )

diff --git a/Changes b/Changes
index abf2636..6a63e5b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -34,6 +34,9 @@ Revision history for DBIx::Class
           arrayref) now emits a deprecation warning
         - Calling the getter $rsrc->from("argument") now throws an exception
           instead of silently discarding the argument
+        - search() calls with an empty select list are deprecated. While DBIC
+          will still issue a SELECT * ..., it now warns given there is nothing
+          higher up in the stack prepared to interpret the result
 
     * New Features
         - DBIC now performs a range of sanity checks on the entire hierarchy

diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index 6557f2e..9b140c1 100644 (file)
--- a/lib/DBIx/Class/SQLMaker.pm
+++ b/lib/DBIx/Class/SQLMaker.pm
@@ -132,6 +132,7 @@ use mro 'c3';
 
 use DBIx::Class::Carp;
 use DBIx::Class::_Util 'set_subname';
+use SQL::Abstract 'is_literal_value';
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
@@ -209,8 +210,28 @@ sub _where_op_NEST {
 sub select {
   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 
+  ($fields, @{$self->{select_bind}}) = length ref $fields
+    ? $self->_recurse_fields( $fields )
+    : $self->_quote( $fields )
+  ;
 
-  ($fields, @{$self->{select_bind}}) = $self->_recurse_fields($fields);
+  # Override the default behavior of SQL::Abstract - SELECT * makes
+  # no sense in the context of DBIC (and has resulted in several
+  # tricky debugging sessions in the past)
+  not length $fields
+    and
+# FIXME - some day we need to enable this, but too many things break
+# ( notably S::L )
+#  # Random value selected by a fair roll of dice
+#  # In seriousness - this has to be a number, as it is much more
+#  # palatable to random engines in a SELECT list
+#  $fields = 42
+#    and
+  carp_unique (
+    "ResultSets with an empty selection are deprecated (you almost certainly "
+  . "did not mean to do that): if this is indeed your intent you must "
+  . "explicitly supply \\'*' to your search()"
+  );
 
   if (defined $offset) {
     $self->throw_exception('A supplied offset must be a non-negative integer')
@@ -327,20 +348,31 @@ sub insert {
 
 sub _recurse_fields {
   my ($self, $fields) = @_;
-  my $ref = ref $fields;
-  return $self->_quote($fields) unless $ref;
-  return $$fields if $ref eq 'SCALAR';
-
-  if ($ref eq 'ARRAY') {
-    my (@select, @bind);
-    for my $field (@$fields) {
-      my ($select, @new_bind) = $self->_recurse_fields($field);
-      push @select, $select;
-      push @bind, @new_bind;
-    }
+
+  if( not length ref $fields ) {
+    return $self->_quote( $fields );
+  }
+
+  elsif( my $lit = is_literal_value( $fields ) ) {
+    return @$lit
+  }
+
+  elsif( ref $fields eq 'ARRAY' ) {
+    my (@select, @bind, @bind_fragment);
+
+    (
+      ( $select[ $#select + 1 ], @bind_fragment ) = length ref $_
+        ? $self->_recurse_fields( $_ )
+        : $self->_quote( $_ )
+    ),
+    ( push @bind, @bind_fragment )
+      for @$fields;
+
     return (join(', ', @select), @bind);
   }
-  elsif ($ref eq 'HASH') {
+
+  # FIXME - really crappy handling of functions
+  elsif ( ref $fields eq 'HASH') {
     my %hash = %$fields;  # shallow copy
 
     my $as = delete $hash{-as};   # if supplied
@@ -348,34 +380,41 @@ sub _recurse_fields {
     my ($func, $rhs, @toomany) = %hash;
 
     # there should be only one pair
-    if (@toomany) {
-      $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
-    }
-
-    if (lc ($func) eq 'distinct' && ref $rhs eq 'ARRAY' && @$rhs > 1) {
-      $self->throw_exception (
-        'The select => { distinct => ... } syntax is not supported for multiple columns.'
-       .' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }'
-       .' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }'
-      );
-    }
-
-    my ($rhs_sql, @rhs_bind) = $self->_recurse_fields($rhs);
-    my $select = sprintf ('%s( %s )%s',
-      $self->_sqlcase($func),
-      $rhs_sql,
-      $as
-        ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
-        : ''
+    $self->throw_exception(
+      "Malformed select argument - too many keys in hash: " . join (',', keys %$fields )
+    ) if @toomany;
+
+    $self->throw_exception (
+      'The select => { distinct => ... } syntax is not supported for multiple columns.'
+     .' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }'
+     .' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }'
+    ) if (
+      lc ($func) eq 'distinct'
+        and
+      ref $rhs eq 'ARRAY'
+        and
+      @$rhs > 1
     );
 
-    return ($select, @rhs_bind);
-  }
-  elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
-    return @{$$fields};
+    my ($rhs_sql, @rhs_bind) = length ref $rhs
+      ? $self->_recurse_fields($rhs)
+      : $self->_quote($rhs)
+    ;
+
+    return(
+      sprintf( '%s( %s )%s',
+        $self->_sqlcase($func),
+        $rhs_sql,
+        $as
+          ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
+          : ''
+      ),
+      @rhs_bind
+    );
   }
+
   else {
-    $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
+    $self->throw_exception( ref($fields) . ' unexpected in _recurse_fields()' );
   }
 }
 

diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
index 89e63e0..0e6eb7e 100644 (file)
--- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm
+++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
@@ -737,16 +737,22 @@ sub _subqueried_limit_attrs {
     my $s = $rs_attrs->{select}[$i];
     my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef;
 
-    # we throw away the @bind here deliberately
-    my ($sql_sel) = $self->_recurse_fields ($s);
+    my ($sql_sel) = length ref $s
+      # we throw away the @bind here deliberately
+      ? $self->_recurse_fields( $s )
+      : $self->_quote( $s )
+    ;
 
     push @sel, {
       arg => $s,
       sql => $sql_sel,
-      unquoted_sql => do {
-        local $self->{quote_char};
-        ($self->_recurse_fields ($s))[0]; # ignore binds again
-      },
+      unquoted_sql => ( length ref $s
+        ? do {
+          local $self->{quote_char};
+          ($self->_recurse_fields ($s))[0]; # ignore binds again
+        }
+        : $s
+      ),
       as =>
         $sql_alias
           ||

diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index f84bd05..f6d598b 100644 (file)
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -216,7 +216,7 @@ use warnings;
 use base 'DBIx::Class::Schema';
 
 use DBIx::Class::Carp;
-use DBIx::Class::_Util 'dbic_internal_try';
+use DBIx::Class::_Util qw( dbic_internal_try UNRESOLVABLE_CONDITION );
 use Scalar::Util 'weaken';
 use namespace::clean;
 
@@ -771,7 +771,7 @@ sub _source_exists
   my ($self, $rs) = @_;
 
   ( dbic_internal_try {
-    $rs->search(\'1=0')->cursor->next;
+    $rs->search( UNRESOLVABLE_CONDITION )->cursor->next;
     1;
   } )
     ? 1

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 7be4202..16d68e5 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -16,7 +16,7 @@ use DBIx::Class::_Util qw(
   quote_sub perlstring serialize dump_value
   dbic_internal_try dbic_internal_catch
   detected_reinvoked_destructor scope_guard
-  mkdir_p
+  mkdir_p UNRESOLVABLE_CONDITION
 );
 use namespace::clean;
 
@@ -2733,7 +2733,9 @@ sub _dbh_columns_info_for {
     return \%result if keys %result;
   }
 
-  my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0'));
+  my $sth = $dbh->prepare(
+    $self->sql_maker->select( $table, \'*', UNRESOLVABLE_CONDITION )
+  );
   $sth->execute;
 
 ### The acrobatics with lc names is necessary to support both the legacy

diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index b85fa78..75438d0 100644 (file)
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -499,7 +499,11 @@ sub _resolve_aliastypes_from_select_args {
       grep
         { $_ !~ / \A \s* \( \s* SELECT \s+ .+? \s+ FROM \s+ .+? \) \s* \z /xsi }
         map
-          { ($sql_maker->_recurse_fields($_))[0] }
+          {
+            length ref $_
+              ? ($sql_maker->_recurse_fields($_))[0]
+              : $sql_maker->_quote($_)
+          }
           @{$attrs->{select}}
     ],
     ordering => [ map

diff --git a/t/sqlmaker/core_quoted.t b/t/sqlmaker/core_quoted.t
index d483a40..8682093 100644 (file)
--- a/t/sqlmaker/core_quoted.t
+++ b/t/sqlmaker/core_quoted.t
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Test::More;
-
+use Test::Warn;
 
 use DBICTest ':DiffSQL';
 
@@ -354,4 +354,15 @@ is_same_sql_bind(
   'bracket quoted table names for UPDATE'
 );
 
+
+# Warning and sane behavior on ... select => [] ...
+warnings_exist {
+  local $TODO = "Some day we need to stop issuing implicit SELECT *";
+  is_same_sql_bind(
+    $schema->resultset("Artist")->search({}, { columns => [] })->as_query,
+    '( SELECT 42 FROM [artist] [me] )',
+    [],
+  );
+} qr/\QResultSets with an empty selection are deprecated (you almost certainly did not mean to do that): if this is indeed your intent you must explicitly supply/;
+
 done_testing;

diff --git a/t/sqlmaker/nest_deprec.t b/t/sqlmaker/nest_deprec.t
index 232274e..6d430ca 100644 (file)
--- a/t/sqlmaker/nest_deprec.t
+++ b/t/sqlmaker/nest_deprec.t
@@ -17,7 +17,7 @@ my $sql_maker = $schema->storage->sql_maker;
 for my $expect_warn (1, 0) {
   warnings_like (
     sub {
-      my ($sql, @bind) = $sql_maker->select ('foo', undef, { -nest => \ 'bar' } );
+      my ($sql, @bind) = $sql_maker->select ('foo', '*', { -nest => \ 'bar' } );
       is_same_sql_bind (
         $sql, \@bind,
         'SELECT * FROM foo WHERE ( bar )', [],