1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
#!/usr/bin/perl
#
# Test the ib_enable_utf8 attribute
#
use strict;
use warnings;
use utf8;
BEGIN {
binmode(STDERR, ':utf8');
binmode(STDOUT, ':utf8');
};
use Test::More;
use lib 't','.';
use Encode qw(encode_utf8);
use TestFirebird;
my $T = TestFirebird->new;
eval "use Test::Exception; 1"
or plan skip_all => 'Test::Exception needed for this test';
plan tests => 37;
# first connect with charset ASCII
my $dsn = $T->{tdsn};
$dsn =~ s/ib_charset=\K[^;]+/ASCII/;
my $attr
= { RaiseError => 1, PrintError => 0, AutoCommit => 1, ChopBlanks => 1 };
my $dbh = DBI->connect( $dsn, $T->{user}, $T->{pass}, $attr );
# …and try to turn on ib_enable_utf8 (should fail)
dies_ok(
sub { $dbh->{ib_enable_utf8} = 1 },
'Setting ib_enable_utf8 on charset ASCII db throws');
$dbh->disconnect;
# now connect with UTF8 charset
$dsn =~ s/ib_charset=\K[^;]+/UTF8/;
$dbh = DBI->connect( $dsn, $T->{user}, $T->{pass}, $attr );
# …and try to set ib_enable_utf8 again
ok( $dbh->{ib_enable_utf8} = 1, 'Set ib_enable_utf8' );
ok( $dbh->{ib_enable_utf8}, 'Get ib_enable_utf8' );
# ------- TESTS ------------------------------------------------------------- #
#
# Find a possible new table name
#
my $table = find_new_table($dbh);
ok($table, qq{Table is '$table'});
#
# Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
id INTEGER PRIMARY KEY,
varchr VARCHAR(20) CHARACTER SET UTF8,
chr CHAR(20) CHARACTER SET UTF8,
blb BLOB SUB_TYPE TEXT CHARACTER SET UTF8
)
DEF
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );
#
# Insert a row into the test table as raw SQL
#
ok( $dbh->do(qq{INSERT INTO $table VALUES (1, 'ASCII varchar', 'ASCII char', 'ASCII blob')}) );
#
# Now, see if selected data is plain ASCII as it should be
#
ok( my $cursor = $dbh->prepare("SELECT * FROM $table WHERE id = ?"),
'SELECT' );
ok( $cursor->execute(1) );
my $row = $cursor->fetchrow_arrayref;
$cursor->finish;
ok( !utf8::is_utf8($row->[0]), 'ASCII varchar' );
ok( !utf8::is_utf8($row->[1]), 'ASCII char' );
ok( !utf8::is_utf8($row->[2]), 'ASCII blob' );
#
# Insert with binding, still ASCII
#
ok( $dbh->do(
"INSERT INTO $table VALUES (2, ?, ?, ?)",
{},
'Still plain varchar',
'Still plain char',
'Still plain blob'
)
);
ok( $cursor->execute(2) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 2 );
is( $row->[1], 'Still plain varchar' );
is( $row->[2], 'Still plain char' );
is( $row->[3], 'Still plain blob' );
#
# Insert UTF8, embedded
#
ok( $dbh->do(
"INSERT INTO $table VALUES(3, 'Værчàr', 'Tæst', '€÷∞')")
);
ok( $cursor->execute(3) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 3 );
is( $row->[1], 'Værчàr' );
is( $row->[2], 'Tæst' );
is( $row->[3], '€÷∞', 'inline unicode blob' );
#
# Insert UTF8, binding
#
ok( $dbh->do(
"INSERT INTO $table VALUES(4, ?, ?, ?)",
{}, 'Værчàr', 'Tæst', '€÷∞'
)
);
ok( $cursor->execute(4) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 4 );
is( $row->[1], 'Værчàr' );
is( $row->[2], 'Tæst' );
is( $row->[3], '€÷∞', 'bound unicode blob' );
#
# Now turn off unicode support. things we fetch should not be flagged as
# unicode anymore
#
$dbh->{ib_enable_utf8} = 0;
ok( !$dbh->{ib_enable_utf8}, 'Turn off ib_enable_utf8' );
ok( $cursor->execute(4) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 4 );
is( $row->[1], encode_utf8('Værчàr'), 'non-unicode varchar' );
is( $row->[2], encode_utf8('Tæst'), 'non-unicode char' );
is( $row->[3], encode_utf8('€÷∞'), 'non-unicode blob' );
#
# ... and drop it.
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
#
# Finally disconnect.
#
ok($dbh->disconnect());
|
