Merge branch 'type_fix'

dbdimp.c

@@ -455,6 +455,7 @@ sqlite_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pa
     imp_dbh->extended_result_codes     = extended;
     imp_dbh->stmt_list                 = NULL;
     imp_dbh->began_transaction         = FALSE;
+    imp_dbh->prefer_numeric_type       = FALSE;
 
     sqlite3_busy_timeout(imp_dbh->db, SQL_TIMEOUT);
 
@@ -737,6 +738,10 @@ sqlite_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
         sqlite3_extended_result_codes(imp_dbh->db, imp_dbh->extended_result_codes);
         return TRUE;
     }
+    if (strEQ(key, "sqlite_prefer_numeric_type")) {
+        imp_dbh->prefer_numeric_type = !(! SvTRUE(valuesv));
+        return TRUE;
+    }
     if (strEQ(key, "sqlite_unicode")) {
 #if PERL_UNICODE_DOES_NOT_WORK_WELL
         sqlite_trace(dbh, imp_dbh, 3, form("Unicode support is disabled for this version of perl."));
@@ -781,6 +786,9 @@ sqlite_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
    if (strEQ(key, "sqlite_extended_result_codes")) {
        return sv_2mortal(newSViv(imp_dbh->extended_result_codes ? 1 : 0));
    }
+   if (strEQ(key, "sqlite_prefer_numeric_type")) {
+       return sv_2mortal(newSViv(imp_dbh->prefer_numeric_type ? 1 : 0));
+   }
    if (strEQ(key, "sqlite_unicode")) {
 #if PERL_UNICODE_DOES_NOT_WORK_WELL
        sqlite_trace(dbh, imp_dbh, 3, "Unicode support is disabled for this version of perl.");
@@ -1358,15 +1366,18 @@ sqlite_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv)
         av_extend(av, i);
         retsv = sv_2mortal(newRV_noinc((SV*)av));
         for (n = 0; n < i; n++) {
-            const char *fieldtype = sqlite3_column_decltype(imp_sth->stmt, n);
+            if (imp_dbh->prefer_numeric_type) {
-            int type = sqlite3_column_type(imp_sth->stmt, n);
+                int type = sqlite3_column_type(imp_sth->stmt, n);
-            /* warn("got type: %d = %s\n", type, fieldtype); */
+                /* warn("got type: %d = %s\n", type, fieldtype); */
-            type = sqlite_type_to_odbc_type(type);
+                type = sqlite_type_to_odbc_type(type);
-            /* av_store(av, n, newSViv(type)); */
+                av_store(av, n, newSViv(type));
-            if (fieldtype)
+            } else {
-                av_store(av, n, newSVpv(fieldtype, 0));
+                const char *fieldtype = sqlite3_column_decltype(imp_sth->stmt, n);
-            else
+                if (fieldtype)
-                av_store(av, n, newSVpv("VARCHAR", 0));
+                    av_store(av, n, newSVpv(fieldtype, 0));
+                else
+                    av_store(av, n, newSVpv("VARCHAR", 0));
+            }
         }
     }
     else if (strEQ(key, "NULLABLE")) {

dbdimp.h

@@ -53,6 +53,7 @@ struct imp_dbh_st {
     int extended_result_codes;
     stmt_list_s * stmt_list;
     bool began_transaction;
+    bool prefer_numeric_type;
 };
 
 /* Statement Handle */

lib/DBD/SQLite.pm

@@ -191,6 +191,8 @@ sub regexp {
 package # hide from PAUSE
     DBD::SQLite::db;
 
+use DBI qw/:sql_types/;
+
 sub prepare {
     my $dbh = shift;
     my $sql = shift;
@@ -773,45 +775,68 @@ sub statistics_info {
     return $sponge_sth;
 }
 
+my @TypeInfoKeys = qw/
+    TYPE_NAME
+    DATA_TYPE
+    COLUMN_SIZE
+    LITERAL_PREFIX
+    LITERAL_SUFFIX
+    CREATE_PARAMS
+    NULLABLE
+    CASE_SENSITIVE
+    SEARCHABLE
+    UNSIGNED_ATTRIBUTE
+    FIXED_PREC_SCALE
+    AUTO_UNIQUE_VALUE
+    LOCAL_TYPE_NAME
+    MINIMUM_SCALE
+    MAXIMUM_SCALE
+    SQL_DATA_TYPE
+    SQL_DATETIME_SUB
+    NUM_PREC_RADIX
+    INTERVAL_PRECISION
+/;
+
+my %TypeInfo = (
+    SQL_INTEGER ,=> {
+        TYPE_NAME => 'INTEGER',
+        DATA_TYPE => SQL_INTEGER,
+        NULLABLE => 2, # no for integer primary key, otherwise yes
+        SEARCHABLE => 3,
+    },
+    SQL_DOUBLE ,=> {
+        TYPE_NAME => 'REAL',
+        DATA_TYPE => SQL_DOUBLE,
+        NULLABLE => 1,
+        SEARCHABLE => 3,
+    },
+    SQL_VARCHAR ,=> {
+        TYPE_NAME => 'TEXT',
+        DATA_TYPE => SQL_VARCHAR,
+        LITERAL_PREFIX => "'",
+        LITERAL_SUFFIX => "'",
+        NULLABLE => 1,
+        SEARCHABLE => 3,
+    },
+    SQL_BLOB ,=> {
+        TYPE_NAME => 'BLOB',
+        DATA_TYPE => SQL_BLOB,
+        NULLABLE => 1,
+        SEARCHABLE => 3,
+    },
+    SQL_UNKNOWN_TYPE ,=> {
+        DATA_TYPE => SQL_UNKNOWN_TYPE,
+    },
+);
+
 sub type_info_all {
-    return; # XXX code just copied from DBD::Oracle, not yet thought about
+    my $idx = 0;
-#    return [
+
-#        {
+    my @info = ({map {$_ => $idx++} @TypeInfoKeys});
-#            TYPE_NAME          =>  0,
+    for my $id (sort {$a <=> $b} keys %TypeInfo) {
-#            DATA_TYPE          =>  1,
+        push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys];
-#            COLUMN_SIZE        =>  2,
+    }
-#            LITERAL_PREFIX     =>  3,
+    return \@info;
-#            LITERAL_SUFFIX     =>  4,
-#            CREATE_PARAMS      =>  5,
-#            NULLABLE           =>  6,
-#            CASE_SENSITIVE     =>  7,
-#            SEARCHABLE         =>  8,
-#            UNSIGNED_ATTRIBUTE =>  9,
-#            FIXED_PREC_SCALE   => 10,
-#            AUTO_UNIQUE_VALUE  => 11,
-#            LOCAL_TYPE_NAME    => 12,
-#            MINIMUM_SCALE      => 13,
-#            MAXIMUM_SCALE      => 14,
-#            SQL_DATA_TYPE      => 15,
-#            SQL_DATETIME_SUB   => 16,
-#            NUM_PREC_RADIX     => 17,
-#        },
-#        [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3,
-#            undef, '0', '0', undef, undef, undef, 1, undef, undef
-#        ],
-#        [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3,
-#            '0', '0', '0', undef, '0', 38, 3, undef, 10
-#        ],
-#        [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3,
-#            '0', '0', '0', undef, undef, undef, 8, undef, 10
-#        ],
-#        [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3,
-#            undef, '0', '0', undef, '0', '0', 11, undef, undef
-#        ],
-#        [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3,
-#            undef, '0', '0', undef, undef, undef, 12, undef, undef
-#        ]
-#    ];
 }
 
 my @COLUMN_INFO = qw(
@@ -1524,6 +1549,10 @@ users because SQLite uses dynamic type system (that means,
 the datatype of a value is associated with the value itself, not
 with its container).
 
+As of version 1.61_02, if you set C<sqlite_prefer_numeric_type>
+database handle attribute to true, C<TYPE> statement handle
+attribute returns an array of integer, as an experiment.
+
 =head2 Performance
 
 SQLite is fast, very fast. Matt processed his 72MB log file with it,

t/27_metadata.t

@@ -45,16 +45,16 @@ $dbh->do("INSERT INTO meta4 VALUES ('xyz', 'b')");
 $sth = $dbh->prepare('SELECT * FROM meta4');
 $sth->execute;
 $sth->fetch;
+
+$dbh->{sqlite_prefer_numeric_type} = 1;
+
 my $types = $sth->{TYPE};
 my $names = $sth->{NAME};
 # diag "Types: @$types\nNames: @$names";
 is scalar @$types, scalar @$names, '$sth->{TYPE} array is same length as $sth->{NAME} array';
-# FIXME: This is wrong! $sth->{TYPE} should return an array of integers see: rt #46873
+# $sth->{TYPE} should return an array of integers see: rt #46873
-TODO: {
+isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
-    local $TODO = '$sth->{TYPE} should return an array of integers.';
+isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
-    isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
+like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
-    isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
+like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';
-    like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
-    like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';
-}
 

t/rt_40594_nullable.t

@@ -17,7 +17,7 @@ BEGIN {
 	}
 }
 
-plan tests => 7;
+plan tests => 6;
 
 my $dbh = connect_ok();
 
@@ -28,7 +28,6 @@ ok $sth->execute;
 my $expected = {
     NUM_OF_FIELDS => 4,
     NAME_lc => [qw/id col1 col2 col3/],
-    TYPE => [qw/INTEGER varchar(2) varchar(2) char(2)/],
     NULLABLE => [qw/0 0 1 0/],
 };