Skip to content

Commit a09571f

Browse files
Add test for JSON datatype
1 parent 78f031b commit a09571f

File tree

2 files changed

+77
-0
lines changed

2 files changed

+77
-0
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ t/40catalog.t
4040
t/40invalid_attributes.t
4141
t/40keyinfo.t
4242
t/40listfields.t
43+
t/40json.t
4344
t/40nulls.t
4445
t/40nulls_prepare.t
4546
t/40numrows.t

t/40json.t

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
use strict;
2+
use warnings;
3+
4+
use DBI;
5+
use DBI::Const::GetInfoType;
6+
use Encode;
7+
use Test::More;
8+
9+
my $tb = Test::More->builder;
10+
binmode $tb->output, ":utf8";
11+
binmode $tb->failure_output, ":utf8";
12+
binmode $tb->todo_output, ":utf8";
13+
14+
use vars qw($test_dsn $test_user $test_password);
15+
use lib '.', 't';
16+
require 'lib.pl';
17+
18+
my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password,
19+
{ RaiseError => 1, PrintError => 0 });
20+
21+
if ($dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq 'MySQL' and $dbh->{mariadb_serverversion} < 50708) {
22+
plan skip_all => "MySQL servers < 5.7.8 do not JSON data type";
23+
}
24+
25+
if ($dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq 'MariaDB' and $dbh->{mariadb_serverversion} < 100207) {
26+
plan skip_all => "MariaDB servers < 10.2.7 do not JSON data type";
27+
}
28+
29+
plan tests => 19;
30+
31+
ok ($dbh->do("DROP TABLE IF EXISTS dbd_mysql_json1"), 'Drop table if exists dbd_mysql_json1' );
32+
33+
ok ($dbh->do('CREATE TABLE dbd_mysql_json1 (my_json JSON)'), 'Create table dbd_mysql_json1' );
34+
35+
ok ($dbh->do("INSERT INTO dbd_mysql_json1 SET my_json = JSON_OBJECT('drink', CONVERT(UNHEX('537AC5916CC5916CC3A9') USING utf8mb4))"), 'Insert example JSON data in hexadecumal form' );
36+
37+
ok (my $sth = $dbh->prepare("INSERT INTO dbd_mysql_json1 VALUES (?)"), 'Prepare insert for JSON data in string form' );
38+
my $input_in_bytes = "{\"drink\": \"Sz\xC5\x91l\xC5\x91l\xC3\xA9\"}";
39+
my $input = Encode::decode('UTF-8', $input_in_bytes);
40+
ok ($sth->execute($input), 'Execute prepared statement with JSON data in string form' );
41+
42+
ok ($sth = $dbh->prepare("SELECT my_json FROM dbd_mysql_json1"), 'Prepare select statement in string form' );
43+
44+
ok ($sth->execute, 'Execute prepared statement' );
45+
46+
ok (my $result = $sth->fetchall_arrayref, 'Fetch JSON data in string form' );
47+
48+
ok (defined($result), 'Result returned defined' );
49+
50+
my $output_in_bytes = "{\"drink\": \"Sz\xC5\x91l\xC5\x91l\xC3\xA9\"}";
51+
my $output = Encode::decode('UTF-8', $output_in_bytes);
52+
if ($dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq 'MySQL') {
53+
# XXX MySQL returns octets instead of internal Perl Unicode
54+
# DBD::MySQL issue: https://github.com/perl5-dbi/DBD-MariaDB/issues/142
55+
# MySQL issue: https://bugs.mysql.com/bug.php?id=95698
56+
is ($result->[0][0], $output_in_bytes, "Should be $output" );
57+
is ($result->[1][0], $output_in_bytes, "Should be $output" );
58+
} else {
59+
is ($result->[0][0], $output, "Should be $output");
60+
is ($result->[1][0], $output, "Should be $output");
61+
}
62+
63+
ok ($sth = $dbh->prepare("SELECT HEX(my_json) FROM dbd_mysql_json1"), 'Prepare select statement in hexadecimal form' );
64+
65+
ok ($sth->execute, 'Execute prepared statement' );
66+
67+
ok ($result = $sth->fetchall_arrayref, "Fetch data" );
68+
69+
ok (defined($result), "Result returned defined" );
70+
71+
is ($result->[0][0], '7B226472696E6B223A2022537AC5916CC5916CC3A9227D', 'Fetch JSON data in hexadecumal form' );
72+
is ($result->[1][0], '7B226472696E6B223A2022537AC5916CC5916CC3A9227D', 'Fetch JSON data in hexadecumal form' );
73+
74+
ok ($dbh->do("DROP TABLE dbd_mysql_json1"), "Drop table dbd_mysql_json1" );
75+
76+
ok ($dbh->disconnect, "Disconnect" );

0 commit comments

Comments
 (0)