DBD-Pg
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.
SHA256 f73a75dbc930bacef282e5e0d2c4628cb686f067d2f97a3f66af3385ab5462f2 t/03dbmethod.t
SHA256 233aff8341a9964beeee7afedcc7acac81592123c4b27116eb077fb02ca3dca0 t/03smethod.t
SHA256 a3767a1b6e9adf62ec73f9d38b8bca151eb2fd872d42c2f77aeaef72178b1c56 t/04misc.t
SHA256 d30d52695492fbcb2d051c48d0d3afb621b0d5b29d876208b5fd79c5bc50b3fa t/06bytea.t
SHA256 f172234f057e485a8d5838db6986dbda18f4fe81fcf9ad0885728b8aec31b852 t/07copy.t
SHA256 2e50d0d3cea8c90882a06b99537d7aebcb8d8f062a775831d4b07056e832c4c1 t/08async.t
SHA256 13939607c75558e63395d0d77e78ed2485cd97b2e3d6559e72ec45bffdf333e4 t/09arrays.t
SHA256 97254af96ad61b3306b55ea687db6e5439e18a692f763aabc74bebe85e0c04c9 t/10_pg_error_field.t
SHA256 9a4b3ba6e7931c21fdeab0225777de3512f68e58fc98305da5073694c5f84afe t/12placeholders.t
SHA256 982a438ec73b0428c263ed4608d82fd466a1668cfd4095c69d93ae002486368c t/20savepoints.t
SHA256 6bdf1b5d0bdc049bf8ff8a66d36fc41dfaea2d15e8550dc7e19ce152aa73c918 t/30unicode.t
SHA256 16b874ee36dcedc566b6c9b4c8142173e3a6babc660721939756d8a0a7d697f2 t/99cleanup.t
SHA256 ad3ea24155b8147b09be5bb9da35ec150cd001293a0c6b7abd46c4389ca7530a t/dbdpg_test_setup.pl
SHA256 3f53191613dc10d2d30414f7e6e31a3b3486d91fe07ee77d24ea3d6f2eb61bb6 t/lib/App/Info.pm
SHA256 8faf2c2b3ff952ff0721c04ac8e04ec143939592b0d55a135ea15d310144f576 t/lib/App/Info/Handler.pm
SHA256 e3c5a92afea9c568bf9534a0f13e84864bce0899d2d96857bdaba2c2c565d6e8 t/lib/App/Info/Handler/Print.pm
SHA256 e98cd9cf586aaba135ca06d9029d881337843620de4856b19465aa78674d08ab t/lib/App/Info/Handler/Prompt.pm
SHA256 8519856d47937472c0ad078827319400c235a4c9ed7dadb9f3449937416d7922 t/lib/App/Info/RDBMS.pm
SHA256 1a04a802a38fa8ba2cf001deb6bb20e0e4f9705b93d45600329372c26e108803 t/lib/App/Info/RDBMS/PostgreSQL.pm
SHA256 17ffc3a80591fbdddc74bd13a622284e05421c58f773c8deaaad6e0eae417c77 t/lib/App/Info/Request.pm
SHA256 0cc067040c7056734dec93ea399d7b4dbc7d202aa5c081e6030081c5ed726ff6 t/lib/App/Info/Util.pm
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;
}
}
/* ================================================================== */
long pg_quickexec (SV * dbh, const char * sql, const int asyncflag)
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.819 second using v1.01-cache-2.11-cpan-f29a10751f0 )