Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add support for BIT type and coerce scalar value to correct types when mysql_server_prepare=0 #53

Merged
merged 2 commits into from
Sep 19, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
84 changes: 79 additions & 5 deletions dbdimp.c
Original file line number Diff line number Diff line change
Expand Up @@ -336,7 +336,6 @@ free_param(pTHX_ imp_sth_ph_t *params, int num_params)
}
}

#if MYSQL_VERSION_ID >= SERVER_PREPARE_VERSION
/*
Convert a MySQL type to a type that perl can handle

Expand All @@ -359,11 +358,14 @@ static enum enum_field_types mysql_to_perl_type(enum enum_field_types type)
case MYSQL_TYPE_LONG:
case MYSQL_TYPE_INT24:
case MYSQL_TYPE_YEAR:
enum_type= MYSQL_TYPE_LONG;
break;

#if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION
case MYSQL_TYPE_BIT:
#endif
enum_type= MYSQL_TYPE_LONG;
enum_type= MYSQL_TYPE_BIT;
break;
#endif

#if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION
case MYSQL_TYPE_NEWDECIMAL:
Expand Down Expand Up @@ -399,7 +401,6 @@ static enum enum_field_types mysql_to_perl_type(enum enum_field_types type)
}
return(enum_type);
}
#endif

#if defined(DBD_MYSQL_EMBEDDED)
/*
Expand Down Expand Up @@ -3517,7 +3518,7 @@ my_ulonglong mysql_st_internal_execute41(
{
for (i = mysql_stmt_field_count(stmt) - 1; i >=0; --i) {
enum_type = mysql_to_perl_type(stmt->fields[i].type);
if (enum_type != MYSQL_TYPE_DOUBLE && enum_type != MYSQL_TYPE_LONG)
if (enum_type != MYSQL_TYPE_DOUBLE && enum_type != MYSQL_TYPE_LONG && enum_type != MYSQL_TYPE_BIT)
{
/* mysql_stmt_store_result to update MYSQL_FIELD->max_length */
my_bool on = 1;
Expand Down Expand Up @@ -3790,6 +3791,12 @@ int dbd_describe(SV* sth, imp_sth_t* imp_sth)
buffer->is_unsigned= (fields[i].flags & UNSIGNED_FLAG) ? 1 : 0;
break;

case MYSQL_TYPE_BIT:
buffer->buffer_length= 8;
Newz(908, fbh->data, buffer->buffer_length, char);
buffer->buffer= (char *) fbh->data;
break;

default:
buffer->buffer_length= fields[i].max_length ? fields[i].max_length : 1;
Newz(908, fbh->data, buffer->buffer_length, char);
Expand Down Expand Up @@ -3846,6 +3853,7 @@ dbd_st_fetch(SV *sth, imp_sth_t* imp_sth)
MYSQL_BIND *buffer;
#endif
MYSQL_FIELD *fields;
const char *data;
if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t-> dbd_st_fetch\n");

Expand Down Expand Up @@ -4029,6 +4037,28 @@ dbd_st_fetch(SV *sth, imp_sth_t* imp_sth)

break;

case MYSQL_TYPE_BIT:
data = fbh->data;
len= fbh->length;
if (len <= 4)
{
/* If there are max 32 bits store it as UV */
int i;
UV bits = 0;
for (i=0; i<len; ++i) {
bits <<= 8;
bits |= data[i];
}
sv_setuv(sv, bits);
}
else
{
/* otherwise store it as raw string */
sv_setpvn(sv, data, len);
}

break;

default:
if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
PerlIO_printf(DBIc_LOGPIO(imp_xxh), "\t\tERROR IN st_fetch_string");
Expand Down Expand Up @@ -4164,7 +4194,49 @@ dbd_st_fetch(SV *sth, imp_sth_t* imp_sth)
while (len && col[len-1] == ' ')
{ --len; }
}

/* Set string value returned from mysql server */
sv_setpvn(sv, col, len);

switch (mysql_to_perl_type(fields[i].type)) {
case MYSQL_TYPE_DOUBLE:
/* Coerce to dobule and set scalar as NV */
(void) SvNV(sv);
SvNOK_only(sv);
break;

case MYSQL_TYPE_LONG:
/* Coerce to integer and set scalar as UV resp. IV */
if (fields[i].flags & UNSIGNED_FLAG)
{
(void) SvUV(sv);
SvIOK_only_UV(sv);
}
else
{
(void) SvIV(sv);
SvIOK_only(sv);
}
break;

#if MYSQL_VERSION_ID > NEW_DATATYPE_VERSION
case MYSQL_TYPE_BIT:
if (len <= 4)
{
/* If there are max 32 bits coerce to UV */
int i;
UV bits = 0;
for (i=0; i<len; ++i) {
bits <<= 8;
bits |= col[i];
}
sv_setuv(sv, bits);
SvIOK_only_UV(sv);
}
break;
#endif

default:
/* UTF8 */
/*HELMUT*/
#if defined(sv_utf8_decode) && MYSQL_VERSION_ID >=SERVER_PREPARE_VERSION
Expand All @@ -4174,6 +4246,8 @@ dbd_st_fetch(SV *sth, imp_sth_t* imp_sth)
sv_utf8_decode(sv);
#endif
/* END OF UTF8 */
break;
}
}
else
(void) SvOK_off(sv); /* Field is NULL, return undef */
Expand Down
56 changes: 49 additions & 7 deletions t/40types.t
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
use strict;
use warnings;

use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV);
use Test::More;
use DBI;
use DBI::Const::GetInfoType;
Expand All @@ -17,16 +18,40 @@ if ($@) {
plan skip_all =>
"no database connection";
}
plan tests => 20;
plan tests => 40;

ok(defined $dbh, "Connected to database");

ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");

ok($dbh->do(qq{CREATE TABLE t1 (num INT)}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES (100)}), "loading data");

my ($val) = $dbh->selectrow_array("SELECT * FROM t1");
is($val, 100);

my $sv = svref_2object(\$val);
ok($sv->FLAGS & SVf_IOK, "scalar is integer");
ok(!($sv->FLAGS & (SVf_IVisUV|SVf_NOK|SVf_POK)), "scalar is not unsigned intger or double or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

ok($dbh->do(qq{CREATE TABLE t1 (num VARCHAR(10))}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES ('string')}), "loading data");

($val) = $dbh->selectrow_array("SELECT * FROM t1");
is($val, "string");

$sv = svref_2object(\$val);
ok($sv->FLAGS & SVf_POK, "scalar is string");
ok(!($sv->FLAGS & (SVf_IOK|SVf_NOK)), "scalar is not intger or double");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

SKIP: {
skip "New Data types not supported by server", 19
skip "New Data types not supported by server", 26
if !MinimumVersion($dbh, '5.0');

ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");

ok($dbh->do(qq{CREATE TABLE t1 (d DECIMAL(5,2))}), "creating table");

my $sth= $dbh->prepare("SELECT * FROM t1 WHERE 1 = 0");
Expand All @@ -52,7 +77,16 @@ ok($sth->bind_param(1, -1, DBI::SQL_DOUBLE), "binding parameter");
ok($sth->execute(), "inserting data");
ok($sth->finish);

is_deeply($dbh->selectall_arrayref("SELECT * FROM t1"), [ ['2.1'], ['-1'] ]);
my $ret = $dbh->selectall_arrayref("SELECT * FROM t1");
is_deeply($ret, [ [2.1], [-1] ]);

$sv = svref_2object(\$ret->[0]->[0]);
ok($sv->FLAGS & SVf_NOK, "scalar is double");
ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string");

$sv = svref_2object(\$ret->[1]->[0]);
ok($sv->FLAGS & SVf_NOK, "scalar is double");
ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

Expand All @@ -62,8 +96,16 @@ ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");
ok($dbh->do(qq{CREATE TABLE t1 (num INT UNSIGNED)}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES (0),(4294967295)}), "loading data");

is_deeply($dbh->selectall_arrayref("SELECT * FROM t1"),
[ ['0'], ['4294967295'] ]);
$ret = $dbh->selectall_arrayref("SELECT * FROM t1");
is_deeply($ret, [ [0], [4294967295] ]);

$sv = svref_2object(\$ret->[0]->[0]);
ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer");
ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string");

$sv = svref_2object(\$ret->[1]->[0]);
ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer");
ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");
};
Expand Down
20 changes: 15 additions & 5 deletions t/rt88006-bit-prepare.t
Original file line number Diff line number Diff line change
Expand Up @@ -31,16 +31,20 @@ EOT

ok $dbh->do($create),"create table for $scenario";

ok $dbh->do("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (1, b'10'), (2, b'1')");
ok $dbh->do("INSERT INTO dbd_mysql_rt88006_bit_prep (id, flags) VALUES (1, b'10'), (2, b'1'), (3, b'1111111111111111111111111111111111111111')");

my $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 1");
ok $sth->execute() or die("Execute failed: ".$DBI::errstr);
ok (my $r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario");
is ($r->{id}, 1, 'id test contents');
TODO: {
local $TODO = "rt88006" if $scenario eq 'prepare';
ok ($r->{flags}, 'flags has contents');
}
ok ($r->{flags}, 'flags has contents');
ok $sth->finish;

ok $sth = $dbh->prepare("SELECT id,flags FROM dbd_mysql_rt88006_bit_prep WHERE id = 3");
ok $sth->execute() or die("Execute failed: ".$DBI::errstr);
ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with more then 32 bits");
is ($r->{id}, 3, 'id test contents');
ok ($r->{flags}, 'flags has contents');
ok $sth->finish;

ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =1");
Expand All @@ -49,6 +53,12 @@ ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN()");
is ($r->{id}, 1, 'id test contents');
ok ($r->{'BIN(flags)'}, 'flags has contents');

ok $sth = $dbh->prepare("SELECT id,BIN(flags) FROM dbd_mysql_rt88006_bit_prep WHERE ID =3");
ok $sth->execute() or die("Execute failed: ".$DBI::errstr);
ok ($r = $sth->fetchrow_hashref(), "fetchrow_hashref for $scenario with BIN() and more then 32 bits");
is ($r->{id}, 3, 'id test contents');
ok ($r->{'BIN(flags)'}, 'flags has contents');

ok $sth->finish;
ok $dbh->disconnect;
}
Expand Down