freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t 00basic.t,NONE,1.1 01connect.t,NONE,1.1 01constants.t,NONE,1.1 01setup.t,NONE,1.1 02prepare.t,NONE,1.1 03bind.t,NONE,1.1 04execute.t,NONE,1.1 05fetch.t,NONE,1.1 06disconnect.t,NONE,1.1 07reuse.t,NONE,1.1 08txn.t,NONE,1.1 09autocommit.t,NONE,1.1 11quoting.t,NONE,1.1 12placeholders.t,NONE,1.1 13pgtype.t,NONE,1.1 15funct.t,NONE,1.1 99cleanup.t,NONE,1.1
ivan
ivan at pouncequick.420.am
Thu Apr 29 02:21:34 PDT 2004
- Previous message: freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App Info.pm,NONE,1.1
- Next message: freeside/install/5.005/DBD-Pg-1.22-fixvercmp Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 Pg.h,NONE,1.1 Pg.pm,NONE,1.1 Pg.xs,NONE,1.1 README,NONE,1.1 README.win32,NONE,1.1 dbd-pg.pod,NONE,1.1 dbdimp.c,NONE,1.1 dbdimp.h,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /home/cvs/cvsroot/freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t
In directory pouncequick:/tmp/cvs-serv10700/DBD-Pg-1.22-fixvercmp/t
Added Files:
00basic.t 01connect.t 01constants.t 01setup.t 02prepare.t
03bind.t 04execute.t 05fetch.t 06disconnect.t 07reuse.t
08txn.t 09autocommit.t 11quoting.t 12placeholders.t 13pgtype.t
15funct.t 99cleanup.t
Log Message:
adding DBD::Pg and DBIx::DBSchema for 5.005. argh freebsd and solaris!
--- NEW FILE: 01constants.t ---
use strict;
use Test::More tests => 20;
use DBD::Pg qw(:pg_types);
ok(PG_BOOL == 16, 'PG_BOOL');
ok(PG_BYTEA == 17, 'PG_BYTEA');
ok(PG_CHAR == 18, 'PG_CHAR');
ok(PG_INT8 == 20, 'PG_INT8');
ok(PG_INT2 == 21, 'PG_INT2');
ok(PG_INT4 == 23, 'PG_INT4');
ok(PG_TEXT == 25, 'PG_TEXT');
ok(PG_OID == 26, 'PG_OID');
ok(PG_FLOAT4 == 700, 'PG_FLOAT4');
ok(PG_FLOAT8 == 701, 'PG_FLOAT8');
ok(PG_ABSTIME == 702, 'PG_ABSTIME');
ok(PG_RELTIME == 703, 'PG_RELTIME');
ok(PG_TINTERVAL == 704, 'PG_TINTERVAL');
ok(PG_BPCHAR == 1042, 'PG_BPCHAR');
ok(PG_VARCHAR == 1043, 'PG_VARCHAR');
ok(PG_DATE == 1082, 'PG_DATE');
ok(PG_TIME == 1083, 'PG_TIME');
ok(PG_DATETIME == 1184, 'PG_DATETIME');
ok(PG_TIMESPAN == 1186, 'PG_TIMESPAN');
ok(PG_TIMESTAMP == 1296, 'PG_TIMESTAMP');
--- NEW FILE: 01connect.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 2;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok((defined $dbh and $dbh->disconnect()),
'connect with transaction'
);
undef $dbh;
$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 1});
ok((defined $dbh and $dbh->disconnect()),
'connect without transaction'
);
--- NEW FILE: 05fetch.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 10;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
$dbh->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
$dbh->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
$dbh->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
ok($dbh->commit(),
'commit'
);
my $sql = <<SQL;
SELECT id
, name
FROM test
SQL
my $sth = $dbh->prepare($sql);
$sth->execute();
my $rows = 0;
while (my ($id, $name) = $sth->fetchrow_array()) {
if (defined($id) && defined($name)) {
$rows++;
}
}
$sth->finish();
ok($rows == 3,
'fetch three rows'
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE 1 = 0
SQL
$sth = $dbh->prepare($sql);
$sth->execute();
$rows = 0;
while (my ($id, $name) = $sth->fetchrow_array()) {
$rows++;
}
$sth->finish();
ok($rows == 0,
'fetch zero rows'
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
SQL
$sth = $dbh->prepare($sql);
$sth->execute(1);
$rows = 0;
while (my ($id, $name) = $sth->fetchrow_array()) {
if (defined($id) && defined($name)) {
$rows++;
}
}
$sth->finish();
ok($rows == 1,
'fetch one row on id'
);
# Attempt to test whether or not we can get unicode out of the database
# correctly. Reuse the previous sth.
SKIP: {
eval "use Encode";
skip "need Encode module for unicode tests", 3 if $@;
local $dbh->{pg_enable_utf8} = 1;
$dbh->do("INSERT INTO test (id, name, val) VALUES (4, '\001\000dam', 'cow')");
$sth->execute(4);
my ($id, $name) = $sth->fetchrow_array();
ok(Encode::is_utf8($name),
'returned data has utf8 bit set'
);
is(length($name), 4,
'returned utf8 data is not corrupted'
);
$sth->finish();
$sth->execute(1);
my ($id2, $name2) = $sth->fetchrow_array();
ok(! Encode::is_utf8($name2),
'returned ASCII data has not got utf8 bit set'
);
$sth->finish();
}
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE name = ?
SQL
$sth = $dbh->prepare($sql);
$sth->execute('foo');
$rows = 0;
while (my ($id, $name) = $sth->fetchrow_array()) {
if (defined($id) && defined($name)) {
$rows++;
}
}
$sth->finish();
ok($rows == 1,
'fetch one row on name'
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 13pgtype.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 3;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
eval {
local $dbh->{PrintError} = 0;
$dbh->do(q{DROP TABLE tt});
$dbh->commit();
};
$dbh->rollback();
$dbh->do(q{CREATE TABLE tt (blah numeric(5,2), foo text)});
my $sth = $dbh->prepare(qq{
SELECT * FROM tt WHERE FALSE
});
$sth->execute();
my @types = @{$sth->{pg_type}};
ok($types[0] eq 'numeric',
'type numeric'
);
ok($types[1] eq 'text',
'type text'
);
$sth->finish();
$dbh->rollback();
$dbh->disconnect();
--- NEW FILE: 11quoting.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 8;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my %tests = (
one=>["'", "'\\" . sprintf("%03o", ord("'")) . "'"],
two=>["''", "'" . ("\\" . sprintf("%03o", ord("'")))x2 . "'"],
three=>["\\", "'\\" . sprintf("%03o", ord("\\")) . "'"],
four=>["\\'", sprintf("'\\%03o\\%03o'", ord("\\"), ord("'"))],
five=>["\\'?:", sprintf("'\\%03o\\%03o?:'", ord("\\"), ord("'"))],
);
foreach my $test (keys %tests) {
my ($unq, $quo, $ref);
$unq = $tests{$test}->[0];
$ref = $tests{$test}->[1];
$quo = $dbh->quote($unq);
ok($quo eq $ref,
"$test: $unq -> expected $quo got $ref"
);
}
# Make sure that SQL_BINARY doesn't work.
# eval { $dbh->quote('foo', { TYPE => DBI::SQL_BINARY })};
eval {
local $dbh->{PrintError} = 0;
$dbh->quote('foo', DBI::SQL_BINARY);
};
ok($@ && $@ =~ /Use of SQL_BINARY invalid in quote/,
'SQL_BINARY'
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 00basic.t ---
print "1..1\n";
use DBI;
use DBD::Pg;
if ($DBD::Pg::VERSION) {
print "ok 1\n";
} else {
print "not ok 1\n";
}
--- NEW FILE: 08txn.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 18;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh1,
'connect first dbh'
);
my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh2,
'connect second dbh'
);
$dbh1->do(q{DELETE FROM test});
ok($dbh1->commit(),
'delete'
);
my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on empty table from dbh1'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on empty table from dbh2'
);
$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch three rows on dbh1'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on dbh2 before commit'
);
ok($dbh1->commit(),
'commit work'
);
$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch on dbh1 after commit'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch on dbh2 after commit'
);
ok($dbh1->do(q{DELETE FROM test}),
'delete'
);
$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on empty table from dbh1'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch on from dbh2 without commit'
);
ok($dbh1->rollback(),
'rollback'
);
$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch on from dbh1 after rollback'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 3,
'fetch on from dbh2 after rollback'
);
ok($dbh1->disconnect(),
'disconnect on dbh1'
);
ok($dbh2->disconnect(),
'disconnect on dbh2'
);
--- NEW FILE: 04execute.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 13;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my $sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
SQL
my $sth = $dbh->prepare($sql);
ok(defined $sth,
"prepare: $sql"
);
$sth->bind_param(1, 1);
ok($sth->execute(),
'exectute with one bind param'
);
$sth->bind_param(1, 2);
ok($sth->execute(),
'exectute with rebinding one param'
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
AND name = ?
SQL
$sth = $dbh->prepare($sql);
ok(defined $sth,
"prepare: $sql"
);
$sth->bind_param(1, 2);
$sth->bind_param(2, 'foo');
ok($sth->execute(),
'exectute with two bind params'
);
eval {
local $dbh->{PrintError} = 0;
$sth = $dbh->prepare($sql);
$sth->bind_param(1, 2);
$sth->execute();
};
ok(!$@,
'execute with only first of two params bound'
);
eval {
local $dbh->{PrintError} = 0;
$sth = $dbh->prepare($sql);
$sth->bind_param(2, 'foo');
$sth->execute();
};
ok(!$@,
'execute with only second of two params bound'
);
eval {
local $dbh->{PrintError} = 0;
$sth = $dbh->prepare($sql);
$sth->execute();
};
ok(!$@,
'execute with neither of two params bound'
);
$sth = $dbh->prepare($sql);
ok($sth->execute(1, 'foo'),
'execute with both params bound in execute'
);
eval {
local $dbh->{PrintError} = 0;
$sth = $dbh->prepare(q{
SELECT id
, name
FROM test
WHERE id = ?
AND name = ?
});
$sth->execute(1);
};
ok($@,
'execute with only one of two params bound in execute'
);
ok($sth->finish(),
'finish'
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 02prepare.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 8;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my $sql = <<SQL;
SELECT *
FROM test
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
$sql = <<SQL;
SELECT id
FROM test
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
$sql = <<SQL;
SELECT id
, name
FROM test
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = 1
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
$sql = <<SQL;
SELECT *
FROM test
WHERE id = ?
AND name = ?
AND value = ?
AND score = ?
and data = ?
SQL
ok($dbh->prepare($sql),
"prepare: $sql"
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 01setup.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 3;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 1});
ok(defined $dbh,'connect without transaction');
{
local $dbh->{PrintError} = 0;
local $dbh->{RaiseError} = 0;
$dbh->do(q{DROP TABLE test});
}
my $sql = <<SQL;
CREATE TABLE test (
id int,
name text,
val text,
score float,
date timestamp default 'now()',
array text[][]
)
SQL
ok($dbh->do($sql),
'create table'
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 07reuse.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 3;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my $sth = $dbh->prepare(q{SELECT * FROM test});
ok($dbh->disconnect(),
'disconnect with un-finished statement'
);
eval {
$sth->execute();
};
ok($@,
'execute on disconnected statement'
);
--- NEW FILE: 03bind.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 11;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my $sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
SQL
my $sth = $dbh->prepare($sql);
ok(defined $sth,
"prepare: $sql"
);
ok($sth->bind_param(1, 'foo'),
'bind int column with string'
);
ok($sth->bind_param(1, 1),
'rebind int column with int'
);
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
AND name = ?
SQL
$sth = $dbh->prepare($sql);
ok(defined $sth,
"prepare: $sql"
);
ok($sth->bind_param(1, 'foo'),
'bind int column with string',
);
ok($sth->bind_param(2, 'bar'),
'bind string column with text'
);
ok($sth->bind_param(2, 'baz'),
'rebind string column with text'
);
ok($sth->finish(),
'finish'
);
# Make sure that we get warnings when we try to use SQL_BINARY.
{
local $SIG{__WARN__} =
sub { ok($_[0] =~ /^Use of SQL type SQL_BINARY/,
'warning with SQL_BINARY'
);
};
$sql = <<SQL;
SELECT id
, name
FROM test
WHERE id = ?
AND name = ?
SQL
$sth = $dbh->prepare($sql);
$sth->bind_param(1, 'foo', DBI::SQL_BINARY);
}
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 99cleanup.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 3;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
ok($dbh->do(q{DROP TABLE test}),
'drop'
);
ok($dbh->disconnect(),
'disconnect'
);
--- NEW FILE: 15funct.t ---
#!/usr/bin/perl -w -I./t
$| = 1;
# vim:ts=2:sw=2:ai:aw:nu:
use DBI qw(:sql_types);
use Data::Dumper;
use strict;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 59;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
#
# Test the different methods, so are expected to fail.
#
my $sth;
# foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
# no strict 'refs';
# printf "%s=%d\n", $_, &{"DBI::$_"};
# }
my $get_info = {
SQL_DBMS_NAME => 17
, SQL_DBMS_VER => 18
, SQL_IDENTIFIER_QUOTE_CHAR => 29
, SQL_CATALOG_NAME_SEPARATOR => 41
, SQL_CATALOG_LOCATION => 114
};
# Ping
eval {
ok( $dbh->ping(), "Testing Ping" );
};
ok ( !$@, "Ping Tested" );
# Get Info
eval {
$sth = $dbh->get_info();
};
ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
$sth = undef;
# Table Info
eval {
$sth = $dbh->table_info();
};
ok ((!$@ and defined $sth), "table_info tested" );
$sth = undef;
# Column Info
eval {
$sth = $dbh->column_info();
};
ok ((!$@ and defined $sth), "column_info tested" );
#ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
$sth = undef;
# Tables
eval {
$sth = $dbh->tables();
};
ok ((!$@ and defined $sth), "tables tested" );
$sth = undef;
# Type Info All
eval {
$sth = $dbh->type_info_all();
};
ok ((!$@ and defined $sth), "type_info_all tested" );
$sth = undef;
# Type Info
eval {
my @types = $dbh->type_info();
die unless @types;
};
ok (!$@, "type_info(undef)");
$sth = undef;
# Quote
eval {
my $val = $dbh->quote();
die unless $val;
};
ok ($@, "quote error expected: $@");
$sth = undef;
# Tests for quote:
my @qt_vals = (1, 2, undef, 'NULL', "ThisIsAString", "This is Another String");
my @expt_vals = (q{'1'}, q{'2'}, "NULL", q{'NULL'}, q{'ThisIsAString'}, q{'This is Another String'});
for (my $x = 0; $x <= $#qt_vals; $x++) {
local $^W = 0;
my $val = $dbh->quote( $qt_vals[$x] );
is( $val, $expt_vals[$x], "$x: quote on $qt_vals[$x] returned $val" );
}
is( $dbh->quote( 1, SQL_INTEGER() ), 1, "quote(1, SQL_INTEGER)" );
# Quote Identifier
eval {
my $val = $dbh->quote_identifier();
die unless $val;
};
ok ($@, "quote_identifier error expected: $@");
$sth = undef;
SKIP: {
skip("get_info() not yet implemented", 1);
# , SQL_IDENTIFIER_QUOTE_CHAR => 29
# , SQL_CATALOG_NAME_SEPARATOR => 41
my $qt = $dbh->get_info( $get_info->{SQL_IDENTIFIER_QUOTE_CHAR} );
my $sep = $dbh->get_info( $get_info->{SQL_CATALOG_NAME_SEPARATOR} );
# Uncomment this line and remove the next line when get_info() is implemented.
# my $cmp_str = qq{${qt}link${qt}${sep}${qt}schema${qt}${sep}${qt}table${qt}};
my $cmp_str = '';
is( $dbh->quote_identifier( "link", "schema", "table" )
, $cmp_str
, q{quote_identifier( "link", "schema", "table" )}
);
}
# Test ping
ok ($dbh->ping, "Ping the current connection ..." );
# Test Get Info.
# SQL_KEYWORDS
# SQL_CATALOG_TERM
# SQL_DATA_SOURCE_NAME
# SQL_DBMS_NAME
# SQL_DBMS_VERSION
# SQL_DRIVER_NAME
# SQL_DRIVER_VER
# SQL_PROCEDURE_TERM
# SQL_SCHEMA_TERM
# SQL_TABLE_TERM
# SQL_USER_NAME
SKIP: {
skip("get_info() not yet implemented", 5);
foreach my $info (sort keys %$get_info) {
my $type = $dbh->get_info($get_info->{$info});
ok( defined $type, "get_info($info) ($get_info->{$info}) " .
($type || '') );
}
}
# Test Table Info
$sth = $dbh->table_info( undef, undef, undef );
ok( defined $sth, "table_info(undef, undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->table_info( undef, undef, undef, "VIEW" );
ok( defined $sth, "table_info(undef, undef, undef, \"VIEW\") tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
# Test Table Info Rule 19a
$sth = $dbh->table_info( '%', '', '');
ok( defined $sth, "table_info('%', '', '',) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
# Test Table Info Rule 19b
$sth = $dbh->table_info( '', '%', '');
ok( defined $sth, "table_info('', '%', '',) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
# Test Table Info Rule 19c
$sth = $dbh->table_info( '', '', '', '%');
ok( defined $sth, "table_info('', '', '', '%',) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
# Test to see if this database contains any of the defined table types.
$sth = $dbh->table_info( '', '', '', '%');
ok( defined $sth, "table_info('', '', '', '%',) tested" );
if ($sth) {
my $ref = $sth->fetchall_hashref( 'TABLE_TYPE' );
foreach my $type ( sort keys %$ref ) {
my $tsth = $dbh->table_info( undef, undef, undef, $type );
ok( defined $tsth, "table_info(undef, undef, undef, $type) tested" );
DBI::dump_results($tsth) if defined $tsth;
$tsth->finish;
}
$sth->finish;
}
$sth = undef;
# Test Column Info
$sth = $dbh->column_info( undef, undef, undef, undef );
ok( defined $sth, "column_info(undef, undef, undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", undef, undef );
ok( defined $sth, "column_info(undef, 'auser', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'ause%'", undef, undef );
ok( defined $sth, "column_info(undef, 'ause%', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser','replicator'", undef, undef );
ok( defined $sth, "column_info(undef, 'auser','replicator', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser','repl%'", undef, undef );
ok( defined $sth, "column_info(undef, 'auser','repl%', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'fred','repl%'", undef, undef );
ok( defined $sth, "column_info(undef, 'fred','repl%', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'fred','jim'", undef, undef );
ok( defined $sth, "column_info(undef, 'fred','jim', undef, undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", undef );
ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", undef );
ok( defined $sth, "column_info(undef, 'auser', 'pga_%', undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", undef );
ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', undef) tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schemaname'" );
ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schemaname') tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schema%'" );
ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schema%') tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", "'schema%'" );
ok( defined $sth, "column_info(undef, 'auser', 'pga_%', 'schema%') tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", "'schema%'" );
ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', 'schema%') tested" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
# Test call to primary_key_info
local ($dbh->{Warn}, $dbh->{PrintError});
$dbh->{PrintError} = $dbh->{Warn} = 0;
# Primary Key Info
eval {
$sth = $dbh->primary_key_info();
die unless $sth;
};
ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
$sth = undef;
# Primary Key
eval {
$sth = $dbh->primary_key();
die unless $sth;
};
ok ($@, "Call to primary_key with 0 arguements, error expected: $@" );
$sth = undef;
$sth = $dbh->primary_key_info(undef, undef, undef );
ok( defined $sth, "Statement handle defined for primary_key_info()" );
if ( defined $sth ) {
while( my $row = $sth->fetchrow_arrayref ) {
local $^W = 0;
# print join( ", ", @$row, "\n" );
}
undef $sth;
}
$sth = $dbh->primary_key_info(undef, undef, undef );
ok( defined $sth, "Statement handle defined for primary_key_info()" );
my ( %catalogs, %schemas, %tables);
my $cnt = 0;
while( my ($catalog, $schema, $table) = $sth->fetchrow_array ) {
local $^W = 0;
$catalogs{$catalog}++ if $catalog;
$schemas{$schema}++ if $schema;
$tables{$table}++ if $table;
$cnt++;
}
ok( $cnt > 0, "At least one table has a primary key." );
$sth = $dbh->primary_key_info(undef, qq{'$ENV{DBI_USER}'}, undef );
ok(
defined $sth
, "Getting primary keys for tables owned by $ENV{DBI_USER}");
DBI::dump_results($sth) if defined $sth;
undef $sth;
SKIP: {
# foreign_key_info
local ($dbh->{Warn}, $dbh->{PrintError});
$dbh->{PrintError} = $dbh->{Warn} = 0;
eval {
$sth = $dbh->foreign_key_info();
die unless $sth;
};
skip "foreign_key_info not supported by driver", 1 if $@;
ok( defined $sth, "Statement handle defined for foreign_key_info()" );
DBI::dump_results($sth) if defined $sth;
$sth = undef;
}
ok( $dbh->disconnect, "Disconnect from database" );
exit(0);
--- NEW FILE: 06disconnect.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 3;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
ok($dbh->disconnect(),
'disconnect'
);
$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
$dbh->disconnect();
$dbh->disconnect();
$dbh->disconnect();
ok($dbh->disconnect(),
'disconnect on already disconnected dbh'
);
--- NEW FILE: 09autocommit.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 12;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 1}
);
ok(defined $dbh1,
'connect first dbh'
);
my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 1}
);
ok(defined $dbh2,
'connect second dbh'
);
ok($dbh1->do(q{DELETE FROM test}),
'delete'
);
my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on empty table from dbh1'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 0,
'fetch on empty table from dbh2'
);
ok($dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')}),
'insert'
);
$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 1,
'fetch one row from dbh1'
);
$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
ok($rows == 1,
'fetch one row from dbh1'
);
local $SIG{__WARN__} = sub {};
ok(!$dbh1->commit(),
'commit'
);
ok(!$dbh1->rollback(),
'rollback'
);
ok($dbh1->disconnect(),
'disconnect on dbh1'
);
ok($dbh2->disconnect(),
'disconnect on dbh2'
);
--- NEW FILE: 12placeholders.t ---
use strict;
use DBI;
use Test::More;
if (defined $ENV{DBI_DSN}) {
plan tests => 9;
} else {
plan skip_all => 'cannot test without DB info';
}
my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, AutoCommit => 0}
);
ok(defined $dbh,
'connect with transaction'
);
my $quo = $dbh->quote("\\'?:");
my $sth = $dbh->prepare(qq{
INSERT INTO test (name) VALUES ($quo)
});
$sth->execute();
my $sql = <<SQL;
SELECT name
FROM test
WHERE name = $quo;
SQL
$sth = $dbh->prepare($sql);
$sth->execute();
my ($retr) = $sth->fetchrow_array();
ok((defined($retr) && $retr eq "\\'?:"),
'fetch'
);
eval {
local $dbh->{PrintError} = 0;
$sth->execute('foo');
};
ok($@,
'execute with one bind param where none expected'
);
$sql = <<SQL;
SELECT name
FROM test
WHERE name = ?
SQL
$sth = $dbh->prepare($sql);
$sth->execute("\\'?:");
($retr) = $sth->fetchrow_array();
ok((defined($retr) && $retr eq "\\'?:"),
'execute with ? placeholder'
);
$sql = <<SQL;
SELECT name
FROM test
WHERE name = :1
SQL
$sth = $dbh->prepare($sql);
$sth->execute("\\'?:");
($retr) = $sth->fetchrow_array();
ok((defined($retr) && $retr eq "\\'?:"),
'execute with :1 placeholder'
);
$sql = <<SQL;
SELECT name
FROM test
WHERE name = '?'
SQL
$sth = $dbh->prepare($sql);
eval {
local $dbh->{PrintError} = 0;
$sth->execute('foo');
};
ok($@,
'execute with quoted ?'
);
$sql = <<SQL;
SELECT name
FROM test
WHERE name = ':1'
SQL
$sth = $dbh->prepare($sql);
eval {
local $dbh->{PrintError} = 0;
$sth->execute('foo');
};
ok($@,
'execute with quoted :1'
);
$sql = <<SQL;
SELECT name
FROM test
WHERE name = '\\\\'
AND name = '?'
SQL
$sth = $dbh->prepare($sql);
eval {
local $dbh->{PrintError} = 0;
local $sth->{PrintError} = 0;
$sth->execute('foo');
};
ok($@,
'execute with quoted ?'
);
$sth->finish();
$dbh->rollback();
ok($dbh->disconnect(),
'disconnect'
);
- Previous message: freeside/install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App Info.pm,NONE,1.1
- Next message: freeside/install/5.005/DBD-Pg-1.22-fixvercmp Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 Pg.h,NONE,1.1 Pg.pm,NONE,1.1 Pg.xs,NONE,1.1 README,NONE,1.1 README.win32,NONE,1.1 dbd-pg.pod,NONE,1.1 dbdimp.c,NONE,1.1 dbdimp.h,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the freeside-commits
mailing list