view release on metacpan or search on metacpan
InterBase.pm view on Meta::CPAN
$drh = DBI::_new_drh($class, {'Name' => 'InterBase',
'Version' => $VERSION,
'Err' => \$DBD::InterBase::err,
'Errstr' => \$DBD::InterBase::errstr,
'Attribution' => 'DBD::InterBase by Edwin Pratomo and Daniel Ritz'});
$drh;
}
# taken from JWIED's DBD::mysql, with slight modification
sub _OdbcParse($$$)
{
my($class, $dsn, $hash, $args) = @_;
my($var, $val);
if (!defined($dsn))
{ return; }
while (length($dsn))
{
if ($dsn =~ /([^;]*)[;]\r?\n?(.*)/s)
t/10dsnlist.t view on Meta::CPAN
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'pNET' || $mdriver eq 'Adabas') {
print "1..0\n";
exit 0;
}
print "Driver is $mdriver\n";
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/20createdrop.t view on Meta::CPAN
my $file;
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/30insertfetch.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl", "DBD-~~dbd_driver~~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/40alltypes.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
my @is_match = (
t/40bindparam.t view on Meta::CPAN
}
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'pNET') {
print "1..0\n";
exit 0;
}
sub ServerError() {
my $err = $DBI::errstr; # Hate -w ...
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
t/40blobs.t view on Meta::CPAN
}
if ($mdriver ne '') {
last;
}
}
if ($dbdriver eq 'mSQL' || $dbdriver eq 'mSQL1') {
print "1..0\n";
exit 0;
}
sub ServerError() {
my $err = $DBI::errstr; # Hate -w ...
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
sub ShowBlob($) {
my ($blob) = @_;
for($i = 0; $i < 8; $i++) {
if (defined($blob) && length($blob) > $i) {
$b = substr($blob, $i*32);
} else {
$b = "";
}
printf("%08lx %s\n", $i*32, unpack("H64", $b));
}
}
t/40cursor.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
while (Testing()) {
t/40cursoron.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
while (Testing()) {
t/40datetime.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
my @is_match = (
t/40doparam.t view on Meta::CPAN
}
if ($mdriver ne '') {
last;
}
}
if ($mdriver eq 'pNET') {
print "1..0\n";
exit 0;
}
sub ServerError() {
my $err = $DBI::errstr; # Hate -w ...
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
t/40listfields.t view on Meta::CPAN
last;
}
}
@table_def = (
["id", "INTEGER", 4, $COL_KEY],
["name", "CHAR", 64, $COL_NULLABLE]
);
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/40nulls.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/40numrows.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl", "DBD-~~dbd_driver~~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
sub TrueRows($) {
my ($sth) = @_;
my $count = 0;
while ($sth->fetchrow_arrayref) {
++$count;
}
$count;
}
#
t/41numeric.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
# expected fetched values
t/50chopblanks.t view on Meta::CPAN
foreach $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/50commit.t view on Meta::CPAN
exit 0;
}
use vars qw($gotWarning);
sub CatchWarning ($) {
$gotWarning = 1;
}
sub NumRows($$$) {
my($dbh, $table, $num) = @_;
my($sth, $got);
if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
return "Failed to prepare: err " . $dbh->err . ", errstr "
. $dbh->errstr;
}
if (!$sth->execute) {
return "Failed to execute: err " . $dbh->err . ", errstr "
. $dbh->errstr;
t/60leaks.t view on Meta::CPAN
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl", "DBD-~~dbd_driver~~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
#
t/61settx.t view on Meta::CPAN
$mdriver = "";
foreach my $file ("lib.pl", "t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
while (Testing()) {
t/InterBase.dbtest view on Meta::CPAN
}
$def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
join(", ", @colDefs), $keyDef);
}
#
# This function generates a list of tables associated to a
# given DSN.
#
sub ListTables(@) {
my($dbh) = shift;
my(@tables);
@tables = $dbh->tables;
if ($dbh->errstr) {
die "Cannot create table list: " . $dbh->errstr;
}
@tables;
}
t/InterBase.dbtest view on Meta::CPAN
# host.
sub HostDsn ($$) {
my($hostname, $dsn) = @_;
"$dsn:$hostname";
}
#
# Return a string for checking, whether a given column is NULL.
#
sub IsNull($) {
my($var) = @_;
"$var IS NULL";
}
#
# Return TRUE, if database supports transactions
#
sub HaveTransactions () {
t/dbdadmin.t view on Meta::CPAN
foreach $file ("lib.pl", "t/lib.pl", "DBD-~~dbd_driver~~/t/lib.pl") {
do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
exit 10;
}
if ($mdriver ne '') {
last;
}
}
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
"\tpermissions, then retry.\n");
exit 10;
}
sub InDsnList($@) {
my($dsn, @dsnList) = @_;
my($d);
foreach $d (@dsnList) {
if ($d =~ /^dbi:[^:]+:$dsn\b/i) {
return 1;
}
}
0;
}