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 438478305d5edb079748d25f7c3fee9d7e9e41ecbbb09bc60fb7e34230468541 t/03dbmethod.t
SHA256 d5707daebd0767965dbce29fcd6e4832f9e825a9e7b7f288b5f697e99dd28487 t/03smethod.t
SHA256 f90291f7b6e62460f234573de7c5c03b86bab10fdd8e5ade3fccfbcef2a4a31b t/04misc.t
SHA256 671ef2d71b6a07075a4c61fb003233aa7bfcda5b95f0d8eb28eaf296f9879b6d t/06bytea.t
SHA256 2911ac070cf23dc9b3f69d98e8c8a559e2b422eb1d849c3300c33e902845b6b3 t/07copy.t
SHA256 f89f6b77272ea066b324254e41d0b8e582b0c54c1a40e5e8a9da75ab47cdba53 t/08async.t
SHA256 3eb19cccca6e2afdfe46ec59743d32bbea3b537d23c01d90675f7f820bfbd51a t/09arrays.t
SHA256 8261ab099249ddfa0f754c22bb9e5143cd866e3c79f16d846773060970c7dfb8 t/10_pg_error_field.t
SHA256 2cc8e606aef26e21664dd4e9fd316cd0e7a785967d3feb9cab51e7d842098b32 t/12placeholders.t
SHA256 982a438ec73b0428c263ed4608d82fd466a1668cfd4095c69d93ae002486368c t/20savepoints.t
SHA256 0fa74a74f959184b3b9027c47c67e8cfe0c4370223029e223d7aaacc22ab3ed0 t/30unicode.t
SHA256 16b874ee36dcedc566b6c9b4c8142173e3a6babc660721939756d8a0a7d697f2 t/99cleanup.t
SHA256 5e51564a82ccfd430ed0fabb8004a21c87ed686160e972083136279003d63b3c 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, "$description 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, "$description 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, "$description 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, "$description 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 $description")
or next;
}
is (length $result, 1, "Got 1 character for $description");
is (ord $result, $ord, "Got correct character for $description");
}
}
$dbh->do('DROP TABLE dbd_pg_test_unicode');
$dbh->commit();
cleanup_database($dbh,'test');
$dbh->disconnect();
done_testing();
( run in 2.719 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )