DBD-PgAsync
view release on metacpan or search on metacpan
Version 2.10.6 (released September 19, 2008)
- Correctly quote all bytea characters.
[Rod Taylor]
(RT ticket #39390)
- Prevent core dump when checking $dbh->{standard_conforming_strings}
on older servers.
[Greg Sabino Mullane]
- Skip unicode tests if server is set to 'LATIN1'
[Greg Sabino Mullane]
Version 2.10.5 (released September 16, 2008)
- Fix SIGNATURE file
Version 2.10.4 (released September 16, 2008)
t/03dbmethod.t
t/03smethod.t
t/04misc.t
t/06bytea.t
t/07copy.t
t/08async.t
t/09arrays.t
t/10_pg_error_field.t
t/12placeholders.t
t/20savepoints.t
t/30unicode.t
t/99cleanup.t
t/lib/App/Info.pm
t/lib/App/Info/Handler.pm
t/lib/App/Info/Handler/Prompt.pm
t/lib/App/Info/Handler/Print.pm
t/lib/App/Info/RDBMS.pm
t/lib/App/Info/RDBMS/PostgreSQL.pm
t/lib/App/Info/Request.pm
t/lib/App/Info/Util.pm
t/08async.t - Tests asynchronous methods.
t/09arrays.t - Tests array manipulation.
t/10_pg_error_field.t - Tests $dbh->pg_error_field function
t/12placeholders.t - Tests placeholders.
t/20savepoints.t - Test savepoints.
t/30unicode.t - Test Unicode. Or at least UTF8.
t/99cleanup.t - Removes anything we have created for the tests (e.g. tables)
t/99_lint.t - Various minor code cleanliness checks. Requires TEST_CRITIC to be set.
t/99_perlcritic.t - Uses Perl::Critic to check Pg.pm and all of the test files.
Requires that TEST_CRITIC is set. It is recommended that you get all the
Perl::Critic policies via Bundle::Perl::Critic::IncludingOptionalDependencies.
.perlcriticrc - Used by the above: we assume tests are run from the main dir.
if (NULL != client_encoding) {
STRLEN len = strlen(client_encoding);
New(0, clean_encoding, len + 1, char);
for (i = 0, j = 0; i < len; i++) {
const char c = toLOWER(client_encoding[i]);
if (isALPHA(c) || isDIGIT(c))
clean_encoding[j++] = c;
};
clean_encoding[j] = '\0';
imp_dbh->client_encoding_utf8 =
(strnEQ(clean_encoding, "utf8", 4) || strnEQ(clean_encoding, "unicode", 8))
? DBDPG_TRUE : DBDPG_FALSE;
Safefree(clean_encoding);
}
else {
imp_dbh->client_encoding_utf8 = DBDPG_FALSE;
}
}
/* ================================================================== */
static long do_stmt(SV *dbh, char const *sql, int want_async,
t/02attribs.t view on Meta::CPAN
$result = $dbh->{pg_standard_conforming_strings};
is ($result, 'on', $t);
$t='DB handle attribute "pg_standard_conforming_strings" returns correct value';
$dbh->do('SET standard_conforming_strings = off');
$result = $dbh->{pg_standard_conforming_strings};
$dbh->do("SET standard_conforming_strings = $oldscs");
is ($result, 'off', $t);
}
# Attempt to test whether or not we can get unicode out of the database
SKIP: {
eval { require Encode; };
skip ('Encode module is needed for unicode tests', 5) if $@;
my $server_encoding = $dbh->selectall_arrayref('SHOW server_encoding')->[0][0];
skip ('Cannot reliably test unicode without a UTF8 database', 5)
if $server_encoding ne 'UTF8';
$SQL = 'SELECT pname FROM dbd_pg_test WHERE id = ?';
$sth = $dbh->prepare($SQL);
$sth->execute(1);
local $dbh->{pg_enable_utf8} = 1;
$t='Quote method returns correct utf-8 characters';
my $utf8_str = chr(0x100).'dam'; # LATIN CAPITAL LETTER A WITH MACRON
is ($dbh->quote( $utf8_str ), "'$utf8_str'", $t);
$t='Able to insert unicode character into the database';
$SQL = "INSERT INTO dbd_pg_test (id, pname, val) VALUES (40, '$utf8_str', 'Orange')";
is ($dbh->do($SQL), '1', $t);
$t='Able to read unicode (utf8) data from the database';
$sth->execute(40);
my $name = $sth->fetchrow_array();
ok (Encode::is_utf8($name), $t);
$t='Unicode (utf8) data returned from database is not corrupted';
is ($name, $utf8_str, $t);
$t='ASCII text returned from database does have utf8 bit set';
$sth->finish();
$sth->execute(1);
t/09arrays.t view on Meta::CPAN
$expected = eval $expected;
## is_deeply does not handle type differences
is ((Dumper $result), (Dumper $expected), $t);
}
}
## Check utf-8 in and out of the database
SKIP: {
eval { require Encode; };
skip ('Encode module is needed for unicode tests', 14) if $@;
my $server_encoding = $dbh->selectall_arrayref('SHOW server_encoding')->[0][0];
skip ('Cannot reliably test unicode without a UTF8 database', 14)
if $server_encoding ne 'UTF8';
$t='String should be UTF-8';
local $dbh->{pg_enable_utf8} = 1;
my $utf8_str = chr(0x100).'dam'; # LATIN CAPITAL LETTER A WITH MACRON
ok (Encode::is_utf8( $utf8_str ), $t);
$t='quote() handles utf8';
my $quoted = $dbh->quote($utf8_str);
is ($quoted, qq{'$utf8_str'}, $t);
t/30unicode.t view on Meta::CPAN
use open qw/ :std :encoding(utf8) /;
require 'dbdpg_test_setup.pl';
select(($|=1,select(STDERR),$|=1)[1]);
my $dbh = connect_database();
if (! $dbh) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
isnt ($dbh, undef, 'Connect to database for unicode testing');
my @tests;
my $server_encoding = $dbh->selectrow_array('SHOW server_encoding');
my $client_encoding = $dbh->selectrow_array('SHOW client_encoding');
# Beware, characters used for testing need to be known to Unicode version 4.0.0,
# which is what perl 5.8.1 shipped with.
foreach (
t/30unicode.t view on Meta::CPAN
[mixed => $range => 'text[]' => [$name_d,$name_u]],
);
}
}
my %ranges = (
UTF8 => qr/.*/,
LATIN1 => qr/\A(?:ascii|latin 1 range)\z/,
);
eval { $dbh->do('DROP TABLE dbd_pg_test_unicode') };
$dbh->commit();
$dbh->do('CREATE TABLE dbd_pg_test_unicode(t TEXT)');
foreach (@tests) {
my ($state, $range, $type, $value) = @$_;
SKIP:
foreach my $test (
{
qtype => 'placeholder',
sql => "SELECT ?::$type",
args => [$value],
},
(($type eq 'text') ? (
{
qtype => 'interpolated',
sql => "SELECT '$value'::$type",
},
{
qtype => 'interpolated insert',
sql => "INSERT INTO dbd_pg_test_unicode VALUES ('$value'::$type)",
},
# Test that what we send is the same as the database's idea of characters:
{
qtype => 'placeholder length',
sql => "SELECT length(?::$type)",
args => [$value],
want => length($value),
},
{
qtype => 'placeholder length insert',
sql => "INSERT INTO dbd_pg_test_unicode VALUES (length(?::$type))",
args => [$value],
want => length($value),
},
{
qtype => 'interpolated length',
sql => "SELECT length('$value'::$type)",
want => length($value),
},
{
qtype => 'interpolated length insert',
sql => "INSERT INTO dbd_pg_test_unicode VALUES (length('$value'::$type))",
want => length($value),
},
):()),
) {
skip "Can't do $range tests with server_encoding='$server_encoding'", 1
if $range !~ ($ranges{$server_encoding} || qr/\A(?:ascii)\z/);
skip 'Cannot perform range tests if client_encoding is not UTF8', 1
if $client_encoding ne 'UTF8';
t/30unicode.t view on Meta::CPAN
eval {
$sth->execute(@args);
};
if ($@) {
diag "Failure: enable_utf8=$enable_utf8, SQL=$test->{sql}, range=$range\n";
die $@;
}
else {
if ($test->{qtype} =~ /insert/) {
$dbh->commit();
$sth = $dbh->prepare('SELECT * FROM dbd_pg_test_unicode');
$sth->execute();
}
my $result = $sth->fetchall_arrayref->[0][0];
is_deeply ($result, $want, "$desc via prepare+execute+fetchall returns proper value");
if ($test->{qtype} !~ /length/) {
# Whilst XS code can set SVf_UTF8 on an IV, the core's SV
# copying code doesn't copy it. So we can't assume that numeric
# values we see "out here" still have it set. Hence skip this
# test for the SQL length() tests.
is (utf8::is_utf8($_), !!$enable_utf8, "$desc via prepare+execute+fetchall returns string with correct UTF-8 flag")
for (ref $result ? @{$result} : $result);
}
}
if ($test->{qtype} =~ /insert/) {
$dbh->do('DELETE FROM dbd_pg_test_unicode');
$dbh->commit();
}
my $result;
if ($test->{qtype} =~ /insert/) {
eval { $dbh->do($test->{sql}, undef, @args) };
if (not $@) {
$dbh->commit();
$result = eval { $dbh->selectall_arrayref('SELECT * FROM dbd_pg_test_unicode')->[0][0] };
}
} else {
$result = eval { $dbh->selectall_arrayref($test->{sql}, undef, @args)->[0][0] };
}
if ($@) {
diag "Failure: enable_utf8=$enable_utf8, SQL=$test->{sql}, range=$range\n";
die $@;
}
else {
is_deeply ($result, $want, "$desc via do/selectall returns proper value");
if ($test->{qtype} !~ /length/) {
# Whilst XS code can set SVf_UTF8 on an IV, the core's SV
# copying code doesn't copy it. So we can't assume that numeric
# values we see "out here" still have it set. Hence skip this
# test for the SQL length() tests.
is (utf8::is_utf8($_), !!$enable_utf8, "$desc via do/selectall returns string with correct UTF-8 flag")
for (ref $result ? @{$result} : $result);
}
}
if ($test->{qtype} =~ /insert/) {
$dbh->do('DELETE FROM dbd_pg_test_unicode');
$dbh->commit();
}
}
}
}
my %ord_max = (
LATIN1 => 255,
UTF8 => 2**31,
);
t/30unicode.t view on Meta::CPAN
# Check this, and convert them to character(s).
# If we didn't, the next two tests are meaningless, so skip them.
is (utf8::decode($result), 1, "Got valid UTF-8 for $desc")
or next;
}
is (length $result, 1, "Got 1 character for $desc");
is (ord $result, $ord, "Got correct character for $desc");
}
}
$dbh->do('DROP TABLE dbd_pg_test_unicode');
$dbh->commit();
cleanup_database($dbh,'test');
$dbh->disconnect();
done_testing();
( run in 0.688 second using v1.01-cache-2.11-cpan-f29a10751f0 )