simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00
Code Issues Releases Wiki Activity

Merge branch 'type_fix'

Browse source
This commit is contained in:
Kenichi Ishigaki 2018-12-01 17:43:36 +09:00
commit 881131445e
5 changed files with 97 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
dbdimp.c
View file

@ -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);
int type = sqlite3_column_type(imp_sth->stmt, n);
/* warn("got type: %d = %s\n", type, fieldtype); */
type = sqlite_type_to_odbc_type(type);
/* av_store(av, n, newSViv(type)); */
if (fieldtype)
av_store(av, n, newSVpv(fieldtype, 0));
else
av_store(av, n, newSVpv("VARCHAR", 0));
if (imp_dbh->prefer_numeric_type) {
int type = sqlite3_column_type(imp_sth->stmt, n);
/* warn("got type: %d = %s\n", type, fieldtype); */
type = sqlite_type_to_odbc_type(type);
av_store(av, n, newSViv(type));
} else {
const char *fieldtype = sqlite3_column_decltype(imp_sth->stmt, n);
if (fieldtype)
av_store(av, n, newSVpv(fieldtype, 0));
else
av_store(av, n, newSVpv("VARCHAR", 0));
}
}
}
else if (strEQ(key, "NULLABLE")) {

1
dbdimp.h
View file

@ -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 */

105
lib/DBD/SQLite.pm
View file

@ -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
# return [
# {
# TYPE_NAME => 0,
# DATA_TYPE => 1,
# COLUMN_SIZE => 2,
# LITERAL_PREFIX => 3,
# 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 $idx = 0;
my @info = ({map {$_ => $idx++} @TypeInfoKeys});
for my $id (sort {$a <=> $b} keys %TypeInfo) {
push @info, [map {$TypeInfo{$id}{$_}} @TypeInfoKeys];
}
return \@info;
}
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,

16
t/27_metadata.t
View file

@ -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
TODO: {
local $TODO = '$sth->{TYPE} should return an array of integers.';
isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';
}
# $sth->{TYPE} should return an array of integers see: rt #46873
isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';

3
t/rt_40594_nullable.t
View file

@ -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/],
};