More robust tests of dependency lazy-loading and delay of more req loads

[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 a04194d..a70da84 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -15,7 +15,6 @@ use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use overload ();
 use Data::Compare (); # no imports!!! guard against insane architecture
-use DBI::Const::GetInfoType (); # no import of retarded global hash
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -1124,12 +1123,13 @@ sub _dbh_get_info {
   my ($self, $info) = @_;
 
   if ($info =~ /[^0-9]/) {
+    require DBI::Const::GetInfoType;
     $info = $DBI::Const::GetInfoType::GetInfoType{$info};
     $self->throw_exception("Info type '$_[1]' not provided by DBI::Const::GetInfoType")
       unless defined $info;
   }
 
-  return $self->_get_dbh->get_info($info);
+  $self->_get_dbh->get_info($info);
 }
 
 sub _describe_connection {
@@ -1573,14 +1573,25 @@ sub _gen_sql_bind {
     $colinfos = $ident->columns_info;
   }
 
-  my ($sql, @bind) = $self->sql_maker->$op( ($from || $ident), @$args );
+  my ($sql, $bind);
+  ($sql, @$bind) = $self->sql_maker->$op( ($from || $ident), @$args );
+
+  $bind = $self->_resolve_bindattrs(
+    $ident, [ @{$args->[2]{bind}||[]}, @$bind ], $colinfos
+  );
 
   if (
     ! $ENV{DBIC_DT_SEARCH_OK}
       and
     $op eq 'select'
       and
-    first { blessed($_->[1]) && $_->[1]->isa('DateTime') } @bind
+    first {
+      length ref $_->[1]
+        and
+      blessed($_->[1])
+        and
+      $_->[1]->isa('DateTime')
+    } @$bind
   ) {
     carp_unique 'DateTime objects passed to search() are not supported '
       . 'properly (InflateColumn::DateTime formats and settings are not '
@@ -1589,9 +1600,7 @@ sub _gen_sql_bind {
       . 'set $ENV{DBIC_DT_SEARCH_OK} to true'
   }
 
-  return( $sql, $self->_resolve_bindattrs(
-    $ident, [ @{$args->[2]{bind}||[]}, @bind ], $colinfos
-  ));
+  return( $sql, $bind );
 }
 
 sub _resolve_bindattrs {
@@ -1620,24 +1629,42 @@ sub _resolve_bindattrs {
   };
 
   return [ map {
-    if (ref $_ ne 'ARRAY') {
-      [{}, $_]
-    }
-    elsif (! defined $_->[0]) {
-      [{}, $_->[1]]
-    }
-    elsif (ref $_->[0] eq 'HASH') {
-      [
-        ($_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype}) ? $_->[0] : $resolve_bindinfo->($_->[0]),
-        $_->[1]
-      ]
-    }
-    elsif (ref $_->[0] eq 'SCALAR') {
-      [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ]
-    }
-    else {
-      [ $resolve_bindinfo->({ dbic_colname => $_->[0] }), $_->[1] ]
+    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 'SCALAR')         ? [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ]
+    :                                     [ $resolve_bindinfo->(
+                                              { dbic_colname => $_->[0] }
+                                            ), $_->[1] ]
+    ;
+
+    if (
+      ! exists $resolved->[0]{dbd_attrs}
+        and
+      ! $resolved->[0]{sqlt_datatype}
+        and
+      length ref $resolved->[1]
+        and
+      ! overload::Method($resolved->[1], '""')
+    ) {
+      require Data::Dumper;
+      local $Data::Dumper::Maxdepth = 1;
+      local $Data::Dumper::Terse = 1;
+      local $Data::Dumper::Useqq = 1;
+      local $Data::Dumper::Indent = 0;
+      local $Data::Dumper::Pad = ' ';
+      $self->throw_exception(
+        'You must supply a datatype/bindtype (see DBIx::Class::ResultSet/DBIC BIND VALUES) '
+      . 'for non-scalar value '. Data::Dumper::Dumper ($resolved->[1])
+      );
     }
+
+    $resolved;
+
   } @$bind ];
 }
 
@@ -2293,21 +2320,25 @@ sub _select_args_to_query {
 }
 
 sub _select_args {
-  my ($self, $ident, $select, $where, $attrs) = @_;
+  my ($self, $ident, $select, $where, $orig_attrs) = @_;
+
+  return (
+    'select', @{$orig_attrs->{_sqlmaker_select_args}}
+  ) if $orig_attrs->{_sqlmaker_select_args};
 
   my $sql_maker = $self->sql_maker;
   my $alias2source = $self->_resolve_ident_sources ($ident);
 
-  $attrs = {
-    %$attrs,
+  my $attrs = {
+    %$orig_attrs,
     select => $select,
     from => $ident,
     where => $where,
 
     # limit dialects use this stuff
     # yes, some CDBICompat crap does not supply an {alias} >.<
-    ( $attrs->{alias} and $alias2source->{$attrs->{alias}} )
-      ? ( _rsroot_rsrc => $alias2source->{$attrs->{alias}} )
+    ( $orig_attrs->{alias} and $alias2source->{$orig_attrs->{alias}} )
+      ? ( _rsroot_rsrc => $alias2source->{$orig_attrs->{alias}} )
       : ()
     ,
   };
@@ -2387,7 +2418,7 @@ sub _select_args {
       and
     @$ident != 1
   ) {
-    ($ident) = $self->_prune_unused_joins ($ident, $select, $where, $attrs);
+    ($ident, $attrs->{_aliastypes}) = $self->_prune_unused_joins ($ident, $select, $where, $attrs);
   }
 
 ###
@@ -2400,7 +2431,9 @@ sub _select_args {
   # invoked, and that's just bad...
 ###
 
-  return ('select', $ident, $select, $where, $attrs, @limit_args);
+  return ( 'select', @{ $orig_attrs->{_sqlmaker_select_args} = [
+    $ident, $select, $where, $attrs, @limit_args
+  ]} );
 }
 
 # Returns a counting SELECT for a simple count