Skip to content

Instantly share code, notes, and snippets.

@choroba

choroba/db_utf8.pl Secret

Created May 30, 2021 20:29
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save choroba/abd48c61418c95ee030d44886ba7412d to your computer and use it in GitHub Desktop.
Save choroba/abd48c61418c95ee030d44886ba7412d to your computer and use it in GitHub Desktop.
Download ZIP
Raw
db_utf8.pl
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use feature qw{ say };
binmode \*STDOUT, ':utf8';
binmode \*STDERR, ':utf8';
use Encode qw{ encode };
use DBI;
my $count;
sub T { ++$count; $_[0] ? 'ok ' : 'not ok ' }
sub ords { '(' . (join ', ', map ord, split //, $_[0] // '') . ')' }
my %auth = (Pg => {name => 'pg_name',
passw => 'pg_password',
dbname => 'postgres',
ODBC => 'ALSO'},
MariaDB => {name => 'maria_name',
passw => 'maria_password',
dbname => 'test',
ODBC => 'ALSO'},
mysql => {name => 'mysql_name',
passw => 'mysql_password',
dbname => 'test',
extra => { mysql_enable_utf8 => 1 },
ODBC => 'ALSO'},
vertica => {name => 'vertica_name',
passw => 'vertica_password',
dbname => 'verticadb',
ODBC => 'ONLY',
ODBC_X => ';server=localhost'},
SQLite => {name => "",
passw => "",
dbname => ':memory:',
extra => { sqlite_unicode => 1 },
ODBC => 'ALSO'});
my %dbh;
for my $driver (keys %auth) {
if (($auth{$driver}{ODBC} // "") ne 'ONLY') {
$dbh{$driver} = eval {
DBI->connect("dbi:$driver:database=$auth{$driver}{dbname}",
$auth{$driver}{name}, $auth{$driver}{passw},
($auth{$driver}{extra}) x exists $auth{$driver}{extra});
} or say "Cannot connect via $driver: ", ($DBI::errstr || $@);
}
if ($auth{$driver}{ODBC}) {
$dbh{"ODBC:$driver"} = eval {
DBI->connect("dbi:ODBC:driver=$driver:database=$auth{$driver}{dbname}"
. ($auth{$driver}{ODBC_X} // ""),
$auth{$driver}{name}, $auth{$driver}{passw})
} or say "Cannot connect via ODBC:$driver: ", ($DBI::errstr || $@);
}
}
my %hex_sql = (
'ODBC Vertica Database' => 'TO_HEX(b)',
Pg => "encode(b, 'hex')",
'ODBC PostgreSQL' => "encode(b, 'hex')",
MariaDB => 'HEX(b)',
'ODBC MariaDB' => 'HEX(b)',
mysql => 'HEX(b)',
'ODBC MySQL' => 'HEX(b)',
SQLite => 'HEX(b)',
'ODBC SQLite' => 'HEX(b)',
);
my %binary_sql = (
'ODBC Vertica Database' => 'VARBINARY(10)',
Pg => 'BYTEA',
'ODBC PostgreSQL' => 'BYTEA',
MariaDB => 'VARBINARY(10)',
'ODBC MariaDB' => 'VARBINARY(10)',
mysql => 'VARBINARY(10)',
'ODBC MySQL' => 'VARBINARY(10)',
SQLite => 'BLOB',
'ODBC SQLite' => 'BLOB',
);
my %binary_type = (
Pg => DBI::SQL_VARBINARY,
'ODBC PostgreSQL' => DBI::SQL_VARBINARY,
'ODBC Vertica Database' => DBI::SQL_VARBINARY,
MariaDB => DBI::SQL_VARBINARY,
'ODBC MariaDB' => DBI::SQL_VARBINARY,
mysql => DBI::SQL_VARBINARY,
'ODBC MySQL' => DBI::SQL_VARBINARY,
SQLite => DBI::SQL_BLOB,
'ODBC SQLite' => DBI::SQL_VARBINARY,
);
for my $dbh (values %dbh) {
next unless $dbh;
my $driver = $dbh->{Driver}->{Name};
$driver .= ' ' . $dbh->get_info(17) if $driver =~ /^ODBC/;
my $desc = '';
$desc .= ' mode=' . ($dbh->{odbc_has_unicode} ? 'UNICODE' : 'ANSI')
if $driver =~ /^ODBC/;
$dbh->do('DROP TABLE IF EXISTS t');
for my $val ("\xC3\xA1",
"\N{U+C3}\N{U+A1}",
"á",
"č",
"\x{263A}",
"\N{U+263A}",
"☺",
"\N{U+11111}"
) {
for my $upgraded (0, 1) {
my $tmp = $val;
next unless $upgraded or $tmp =~ /^[\x00-\xFF]*$/;
{
my $ins = $val;
$upgraded ? utf8::upgrade($ins) : utf8::downgrade($ins);
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
my $sth = $dbh->prepare("INSERT INTO t(S) VALUES('$ins')");
if (not $sth) {
say T(0), $driver . $desc . ' NORM ' . ($upgraded ? 'upgraded' : 'downgraded') . ' prepare without bind';
} else {
$sth->execute;
my $fetch = $dbh->selectrow_array("SELECT s FROM t");
say T($ins eq $fetch), "$driver$desc NORM " . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
}
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$upgraded ? utf8::upgrade($ins) : utf8::downgrade($ins);
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
my $sth = $dbh->prepare("INSERT INTO t(s) VALUES(?)");
$sth->execute($ins);
my $fetch = $dbh->selectrow_array("SELECT s FROM t");
say T($ins eq $fetch), "$driver$desc NORM " . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$upgraded ? utf8::upgrade($ins) : utf8::downgrade($ins);
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
$dbh->do("INSERT INTO t(s) VALUES('$ins')");
my ($fetch) = $dbh->selectrow_array("SELECT s FROM t");
say T($ins eq $fetch), $driver . $desc . ' NORM ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$upgraded ? utf8::upgrade($ins) : utf8::downgrade($ins);
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
$dbh->do("INSERT INTO t(s) VALUES(?)", undef, $ins);
my ($fetch) = $dbh->selectrow_array("SELECT s FROM t");
say T($ins eq $fetch), $driver . $desc . ' NORM ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do with bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
}
# Binary
my $hex_sql = $hex_sql{$driver};
my $binary_sql = $binary_sql{$driver};
my $binary_type = $binary_type{$driver};
my $bins = encode('UTF-8', $val);
for my $upgraded (0, 1) {
$upgraded ? utf8::upgrade($bins) : utf8::downgrade($bins);
if ($driver !~ /^ODBC/) {
$dbh->do("CREATE TABLE t(b $binary_sql)");
my $sth = $dbh->prepare("INSERT INTO t(b) VALUES(" . $dbh->quote($bins, $binary_type) . ")");
if (not $sth) {
say T(0), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' prepare with quote';
} else {
$sth->execute;
my $fetch = $dbh->selectrow_array("SELECT b FROM t");
say T($bins eq $fetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($bins) . '; fetch: ' . ords($fetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
}
$dbh->do("DROP TABLE t");
}
{
$dbh->do("CREATE TABLE t(b $binary_sql)");
my $sth = $dbh->prepare("INSERT INTO t(b) VALUES(?)");
if (not $sth) {
say T(0), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' prepare without quote';
} else {
$sth->bind_param(1, $bins, $binary_type);
$sth->execute;
my $fetch = $dbh->selectrow_array("SELECT b FROM t");
say T($bins eq $fetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($bins) . '; fetch: ' . ords($fetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
}
$dbh->do("DROP TABLE t");
}
if ($driver !~ /^ODBC/) {
$dbh->do("CREATE TABLE t(b $binary_sql)");
$dbh->do("INSERT INTO t(b) VALUES(" . $dbh->quote($bins, $binary_type) . ")");
my ($fetch) = $dbh->selectrow_array("SELECT b FROM t");
say T($bins eq $fetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($bins) . '; fetch: ' . ords($fetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
$dbh->do("DROP TABLE t");
}
}
# Combined binary + Unicode
for my $upgraded (0, 1) {
$upgraded ? utf8::upgrade($bins) : utf8::downgrade($bins);
if ($driver !~ /^ODBC/) {
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10), b $binary_sql)");
my $sth = $dbh->prepare("INSERT INTO t(s, b) VALUES(" . qq('$ins') . ", " . $dbh->quote($bins, $binary_type) . ")");
if (not $sth) {
say T(0), $driver . $desc . ' COMB ' . ($upgraded ? 'upgraded' : 'downgraded') . ' prepare with quote';
} else {
$sth->execute;
my ($fetch, $bfetch) = $dbh->selectrow_array("SELECT s, b FROM t");
say T($ins eq $fetch), $driver . $desc . ' COMB ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
say T($bins eq $bfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($bins) . '; fetch: ' . ords($bfetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e without bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
}
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10), b $binary_sql)");
my $sth = $dbh->prepare("INSERT INTO t(s, b) VALUES(?, ?)");
if (not $sth) {
say T(0), $driver . $desc . ' COMB ' . ($upgraded ? 'upgraded' : 'downgraded') . ' prepare without quote';
} else {
$sth->bind_param(1, $ins);
$sth->bind_param(2, $bins, $binary_type);
$sth->execute;
my ($fetch, $bfetch) = $dbh->selectrow_array("SELECT s, b FROM t");
say T($ins eq $fetch), $driver . $desc . ' COMB ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
say T($bins eq $bfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($bins) . '; fetch: ' . ords($bfetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' p+e with bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
}
$dbh->do("DROP TABLE t");
}
if ($driver !~ /^ODBC/) {
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10), b $binary_sql)");
$dbh->do("INSERT INTO t(s, b) VALUES(" . qq('$ins') . ", " . $dbh->quote($bins, $binary_type) . ")");
my ($fetch, $bfetch) = $dbh->selectrow_array("SELECT s, b FROM t");
say T($ins eq $fetch), $driver . $desc . ' COMB ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($ins) . '; fetch: ' . ords($fetch);
say T($bins eq $bfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($bins) . '; fetch: ' . ords($bfetch);
my $hfetch = pack "H*", $dbh->selectrow_array("SELECT $hex_sql FROM t");
say T($bins eq $hfetch), $driver . $desc . ' COMB BIN ' . ($upgraded ? 'upgraded' : 'downgraded') . ' do without bind - insert: ' . ords($bins) . '; hex fetch: ' . ords($hfetch);
$dbh->do("DROP TABLE t");
}
}
# Pg COPY DATA
if ($driver eq 'Pg') {
{
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
$dbh->do("INSERT INTO t(s) VALUES(?)", undef, $ins);
$dbh->do("COPY t TO STDOUT");
my @data; my $i = 0;
1 while $dbh->pg_getcopydata(\$data[$i++]) >= 0;
my ($fetch) = ($data[0] =~ /^(.*)\n$/);
say T($ins eq $fetch), 'Pg COPY TO STDOUT: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
$dbh->do("COPY t FROM STDIN");
$dbh->pg_putcopydata($ins);
$dbh->pg_putcopyend;
my $fetch = $dbh->selectrow_array("SELECT s FROM t");
say T($ins eq $fetch), 'Pg COPY FROM STDIN: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
{
my $ins = $val;
$dbh->do("CREATE TABLE t(s VARCHAR(10))");
$dbh->do("COPY t FROM STDIN");
$dbh->pg_putcopydata($ins);
$dbh->pg_putcopyend;
$dbh->do("COPY t TO STDOUT");
my @data; my $i = 0;
1 while $dbh->pg_getcopydata(\$data[$i++]) >= 0;
my ($fetch) = ($data[0] =~ /^(.*)\n$/);
say T($ins eq $fetch), 'Pg COPY FROM STDIN + COPY TO STDOUT: ' . ords($ins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
for my $upgraded (0, 1) {
$upgraded ? utf8::upgrade($bins) : utf8::downgrade($bins);
{
$dbh->do("CREATE TABLE t(b $binary_sql)");
my $sth = $dbh->prepare("INSERT INTO t(b) VALUES(?)");
$sth->bind_param(1, $bins, $binary_type);
$sth->execute;
$dbh->do("COPY t TO STDOUT (FORMAT BINARY)");
my @data; my $i = 0;
1 while $dbh->pg_getcopydata(\$data[$i++]) >= 0;
my ($fetch) = ($data[0] =~ /^PGCOPY\n\xff\r\n\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01....(.*)$/s);
say T($bins eq $fetch), 'Pg COPY TO STDOUT BINARY: ' . ($upgraded ? 'upgraded' : 'downgraded') . ': ' . ords($bins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
{
$dbh->do("CREATE TABLE t(b $binary_sql)");
$dbh->do("COPY t FROM STDIN (FORMAT BINARY)");
$dbh->pg_putcopydata("PGCOPY\n\xff\r\n\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01" . pack('N', length $bins) . $bins);
$dbh->pg_putcopydata("\xff\xff");
$dbh->pg_putcopyend;
my $fetch = $dbh->selectrow_array("SELECT b FROM t");
say T($bins eq $fetch), 'Pg COPY FROM STDIN BINARY ' . ($upgraded ? 'upgraded' : 'downgraded') . ': ' . ords($bins) . '; fetch: ' . ords($fetch);
$dbh->do("DROP TABLE t");
}
}
}
}
}
say "1..$count";
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment