add ::DBI::_is_integer_type and use for SQLite

Add _is_integer_type to check whether a data_type is an integer type
from any database, like we already have _is_lob_type. Use it for the
SQL_INTEGER bind in the SQLite driver.

Also for ::SQLite check for a generic numeric type with a zero scale
such as NUMBER(38,0) and make it a SQL_INTEGER bind.

Move the ::SQLite integer type checks into _resolve_bindattrs in order
to cache the result of the check in the column_info, since the regexes
are very hairy.

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index f092bfa..5a151fa 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2958,6 +2958,22 @@ sub _is_text_lob_type {
                         |national\s*character\s*varying))\z/xi);
 }
 
+# Determine if a data type is some type if integer
+sub _is_integer_type {
+  my ($self, $data_type) = @_;
+  $data_type && (
+       $data_type =~ /^(?:tiny|small|medium|big)?int(?:eger)?(?:\s+unsigned)?\z/i
+    || $data_type =~ /^int(?:eger)?\s+identity\z/i # Sybase ASE/MSSQL
+    || $data_type =~ /^(?:big)?serial\z/i # Pg/MySQL
+    || $data_type =~ /^serial(?:8|4|2|1)\z/i # Pg/MySQL
+    || $data_type =~ /^int(?:eger)?(?:8|4|2|1)\z/i
+    || lc($data_type) eq 'year' # MySQL
+    || lc($data_type) eq 'autoincrement' # MSAccess
+    || $data_type =~ /^(?:long|short)(?:\s+int(?:eger)?)?\z/i # MSAccess
+    || $data_type =~ /^(?:bit|logical1?|yesno)\z/i # MSAccess
+  )
+}
+
 1;
 
 =head1 USAGE NOTES

diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 6943c77..910ba5d 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -108,11 +108,54 @@ sub deployment_statements {
   $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
 }
 
-sub bind_attribute_by_data_type {
-  $_[1] =~ /^ (?: int(?:eger)? | (?:tiny|small|medium)int ) $/ix
-    ? do { require DBI; DBI::SQL_INTEGER() }
-    : undef
-  ;
+# In addition to checking for integer data_types, we need to check for generic
+# NUMBER data_types with a zero scale, such as NUMBER(38,0) in Oracle, which are
+# integer types. Because bind_attribute_by_data_type cannot check the
+# column_info size, and the regexes are very hairy, we do the checking in
+# _resolve_bindattrs and cache the result of the check in the column_info.
+#
+sub _resolve_bindattrs {
+  my $self = shift;
+  my ($ident, $bind, $colinfos) = @_;
+
+  $colinfos = $self->_resolve_column_info($ident)
+    unless keys %$colinfos;
+
+  my $binds = $self->next::method(@_);
+
+  BIND: foreach my $bind (@$binds) {
+    my $attrs     = $bind->[0];
+    my $col       = $attrs->{dbic_colname};
+
+    if (exists $colinfos->{$col}{_is_integer_data_type}
+        && $colinfos->{$col}{_is_integer_data_type} == 1) { # cached
+
+      $attrs->{dbd_attrs} = do { require DBI; DBI::SQL_INTEGER() };
+      next BIND;
+    }
+
+    my $data_type = $attrs->{sqlt_datatype};
+    my $size      = $attrs->{sqlt_size};
+
+    my $is_int_type = $self->_is_integer_type($data_type) ? 1 : 0;
+
+    # This should really live in ::DBI and cache in column_info, but currently
+    # only needed in SQLite.
+    if ((not $is_int_type)
+        && (ref $size eq 'ARRAY' && $size->[1] == 0)
+        && $data_type =~ /^(?:real|float|double(?:\s+precision)?|dec(?:imal)?|numeric|number|fixed|money|currency)(?:\s+unsigned)?\z/i) {
+
+      $is_int_type = 1;
+    }
+
+    if ($is_int_type) {
+      $attrs->{dbd_attrs} = do { require DBI; DBI::SQL_INTEGER() };
+
+      $colinfos->{$col}{_is_integer_data_type} = 1; # cache
+    }
+  }
+
+  return $binds;
 }
 
 # DBD::SQLite (at least up to version 1.31 has a bug where it will
@@ -124,8 +167,10 @@ sub bind_attribute_by_data_type {
 # FIXME - when a DBD::SQLite version is released that eventually fixes
 # this sutiation (somehow) - no-op this override once a proper DBD
 # version is detected
+#
 sub _dbi_attrs_for_bind {
   my ($self, $ident, $bind) = @_;
+
   my $bindattrs = $self->next::method($ident, $bind);
 
   for (0.. $#$bindattrs) {

diff --git a/t/752sqlite.t b/t/752sqlite.t
index 1446128..739f556 100644 (file)
--- a/t/752sqlite.t
+++ b/t/752sqlite.t
@@ -5,6 +5,7 @@ use Test::More;
 use Test::Exception;
 use Test::Warn;
 use Config;
+use Try::Tiny;
 
 use lib qw(t/lib);
 use DBICTest;
@@ -84,18 +85,39 @@ for my $bi (qw/
   9223372036854775806
   9223372036854775807
 /) {
-  $row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
-  is ($row->bigint, $bi, "value in object correct ($bi)");
+  lives_ok {
+    $row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
+  } 'inserted a bigint';
+  is (try { $row->bigint }, $bi, "value in object correct ($bi)");
 
   TODO: {
     local $TODO = 'This perl does not seem to have 64bit int support - DBI roundtrip of large int will fail'
       unless $Config{ivsize} >= 8;
 
     $row->discard_changes;
-    is ($row->bigint, $bi, "value in database correct ($bi)");
+    is (try { $row->bigint }, $bi, "value in database correct ($bi)");
   }
 }
 
+my $artists_with_more_than_one_cd = $schema->resultset('Artist')->search({}, {
+  join => 'cds',
+  '+select' => [ { count => 'cds.cdid', -as => 'cd_count' } ],
+  '+as' => ['cd_count'],
+  group_by => ['me.artistid'],
+  having => [ { cd_count => { '>' => 1 } } ],
+});
+
+my %artist_cd_counts;
+
+lives_ok {
+  while (my $row = $artists_with_more_than_one_cd->next) {
+    $artist_cd_counts{ $row->name } = $row->get_column('cd_count');
+  }
+} 'HAVING int comparison query with a bind survived';
+
+ok ((keys %artist_cd_counts),
+  'HAVING int comparison query with a bind returned results');
+
 done_testing;
 
 # vim:sts=2 sw=2: