Consolidate handling of "is this a literal" and "is this a value"

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 5245bea..a213c95 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -13,8 +13,8 @@ use List::Util qw/first/;
 use Sub::Name 'subname';
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
-use overload ();
 use Data::Compare (); # no imports!!! guard against insane architecture
+use DBIx::Class::_Util qw(is_plain_value is_literal_value);
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -1061,6 +1061,7 @@ sub _populate_dbh {
 
   $self->_dbh(undef); # in case ->connected failed we might get sent here
   $self->_dbh_details({}); # reset everything we know
+  $self->_sql_maker(undef); # this may also end up being different
 
   $self->_dbh($self->_connect);
 
@@ -1694,13 +1695,10 @@ sub _gen_sql_bind {
 sub _resolve_bindattrs {
   my ($self, $ident, $bind, $colinfos) = @_;
 
-  $colinfos ||= {};
-
   my $resolve_bindinfo = sub {
     #my $infohash = shift;
 
-    %$colinfos = %{ $self->_resolve_column_info($ident) }
-      unless keys %$colinfos;
+    $colinfos ||= { %{ $self->_resolve_column_info($ident) } };
 
     my $ret;
     if (my $col = $_[0]->{dbic_colname}) {
@@ -1720,10 +1718,16 @@ sub _resolve_bindattrs {
     my $resolved =
       ( ref $_ ne 'ARRAY' or @$_ != 2 ) ? [ {}, $_ ]
     : ( ! defined $_->[0] )             ? [ {}, $_->[1] ]
-    : (ref $_->[0] eq 'HASH')           ? [ (exists $_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype})
-                                              ? $_->[0]
-                                              : $resolve_bindinfo->($_->[0])
-                                            , $_->[1] ]
+    : (ref $_->[0] eq 'HASH')           ? [(
+                                            ! keys %{$_->[0]}
+                                              or
+                                            exists $_->[0]{dbd_attrs}
+                                              or
+                                            $_->[0]{sqlt_datatype}
+                                           ) ? $_->[0]
+                                             : $resolve_bindinfo->($_->[0])
+                                           , $_->[1]
+                                          ]
     : (ref $_->[0] eq 'SCALAR')         ? [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ]
     :                                     [ $resolve_bindinfo->(
                                               { dbic_colname => $_->[0] }
@@ -1737,7 +1741,7 @@ sub _resolve_bindattrs {
         and
       length ref $resolved->[1]
         and
-      ! overload::Method($resolved->[1], '""')
+      ! is_plain_value $resolved->[1]
     ) {
       require Data::Dumper;
       local $Data::Dumper::Maxdepth = 1;
@@ -1891,15 +1895,9 @@ sub _bind_sth_params {
       );
     }
     else {
-      # FIXME SUBOPTIMAL - most likely this is not necessary at all
-      # confirm with dbi-dev whether explicit stringification is needed
-      my $v = ( length ref $bind->[$i][1] and overload::Method($bind->[$i][1], '""') )
-        ? "$bind->[$i][1]"
-        : $bind->[$i][1]
-      ;
       $sth->bind_param(
         $i + 1,
-        $v,
+        $bind->[$i][1],
         $bind_attrs->[$i],
       );
     }
@@ -1919,9 +1917,7 @@ sub _prefetch_autovalues {
       (
         ! exists $to_insert->{$col}
           or
-        ref $to_insert->{$col} eq 'SCALAR'
-          or
-        (ref $to_insert->{$col} eq 'REF' and ref ${$to_insert->{$col}} eq 'ARRAY')
+        is_literal_value($to_insert->{$col})
       )
     ) {
       $values{$col} = $self->_sequence_fetch(
@@ -1958,11 +1954,9 @@ sub insert {
     }
 
     # nothing to retrieve when explicit values are supplied
-    next if (defined $to_insert->{$col} and ! (
-      ref $to_insert->{$col} eq 'SCALAR'
-        or
-      (ref $to_insert->{$col} eq 'REF' and ref ${$to_insert->{$col}} eq 'ARRAY')
-    ));
+    next if (
+      defined $to_insert->{$col} and ! is_literal_value($to_insert->{$col})
+    );
 
     # the 'scalar keys' is a trick to preserve the ->columns declaration order
     $retrieve_cols{$col} = scalar keys %retrieve_cols if (
@@ -2042,18 +2036,6 @@ sub insert_bulk {
 
   my @col_range = (0..$#$cols);
 
-  # FIXME SUBOPTIMAL - most likely this is not necessary at all
-  # confirm with dbi-dev whether explicit stringification is needed
-  #
-  # forcibly stringify whatever is stringifiable
-  # ResultSet::populate() hands us a copy - safe to mangle
-  for my $r (0 .. $#$data) {
-    for my $c (0 .. $#{$data->[$r]}) {
-      $data->[$r][$c] = "$data->[$r][$c]"
-        if ( length ref $data->[$r][$c] and overload::Method($data->[$r][$c], '""') );
-    }
-  }
-
   my $colinfos = $source->columns_info($cols);
 
   local $self->{_autoinc_supplied_for_op} =
@@ -2180,7 +2162,7 @@ sub insert_bulk {
         }
       }
       elsif (! defined $value_type_by_col_idx->{$col_idx} ) {  # regular non-literal value
-        if (ref $val eq 'SCALAR' or (ref $val eq 'REF' and ref $$val eq 'ARRAY') ) {
+        if (is_literal_value($val)) {
           $bad_slice_report_cref->("Literal SQL found where a plain bind value is expected", $row_idx, $col_idx);
         }
       }
@@ -2290,12 +2272,21 @@ sub _dbh_execute_for_fetch {
   my $fetch_tuple = sub {
     return undef if ++$fetch_row_idx > $#$data;
 
-    return [ map { defined $_->{_literal_bind_subindex}
-      ? ${ $data->[ $fetch_row_idx ]->[ $_->{_bind_data_slice_idx} ]}
-         ->[ $_->{_literal_bind_subindex} ]
-          ->[1]
-      : $data->[ $fetch_row_idx ]->[ $_->{_bind_data_slice_idx} ]
-    } map { $_->[0] } @$proto_bind];
+    return [ map {
+      ! defined $_->{_literal_bind_subindex}
+
+        ? $data->[ $fetch_row_idx ]->[ $_->{_bind_data_slice_idx} ]
+
+        # There are no attributes to resolve here - we already did everything
+        # when we constructed proto_bind. However we still want to sanity-check
+        # what the user supplied, so pass stuff through to the resolver *anyway*
+        : $self->_resolve_bindattrs (
+            undef,  # a fake rsrc
+            [ ${ $data->[ $fetch_row_idx ]->[ $_->{_bind_data_slice_idx} ]}->[ $_->{_literal_bind_subindex} ] ],
+            {},     # a fake column_info bag
+          )->[0][1]
+
+    } map { $_->[0] } @$proto_bind ];
   };
 
   my $tuple_status = [];