From: Rafael Kitover Date: Sat, 14 Apr 2012 16:31:24 +0000 (-0400) Subject: add ::DBI::_is_integer_type and use for SQLite X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Ftopic%2Fis_int_type;p=dbsrgits%2FDBIx-Class.git 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 --- 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 --- 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 --- 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: