#!/usr/bin/perl
use strict;
use FindBin qw($Bin);
use Rose::DB;
BEGIN
{
Rose::DB->default_domain('test');
#
# PostgreSQL
#
eval { require DBD::Pg };
$ENV{'PGDATESTYLE'} = 'MDY';
no warnings 'uninitialized';
# Many tests don't work with DBD::Pg version 2.1.x and 2.2.0
unless($DBD::Pg::VERSION =~ /^2\.(?:1\.|2\.0)/)
{
# Main
Rose::DB->register_db(
domain => 'test',
type => 'pg',
driver => 'Pg',
database => 'test',
host => 'localhost',
username => 'postgres',
password => '',
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'SET default_transaction_isolation TO "read committed"',
],
);
# Private schema
Rose::DB->register_db(
domain => 'test',
type => 'pg_with_schema',
schema => 'rose_db_object_private',
driver => 'Pg',
database => 'test',
host => 'localhost',
username => 'postgres',
password => '',
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'SET default_transaction_isolation TO "read committed"',
],
);
# Admin
Rose::DB->register_db(
domain => 'test',
type => 'pg_admin',
driver => 'Pg',
database => 'test',
host => 'localhost',
username => 'postgres',
password => '',
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'SET default_transaction_isolation TO "read committed"',
],
);
}
#
# MySQL
#
# Main
Rose::DB->register_db(
domain => 'test',
type => 'mysql',
driver => 'mysql',
database => 'test',
host => 'localhost',
username => 'root',
password => ''
);
# Admin
Rose::DB->register_db(
domain => 'test',
type => 'mysql_admin',
driver => 'mysql',
database => 'test',
host => 'localhost',
username => 'root',
password => ''
);
#
# Informix
#
# Main
Rose::DB->register_db(
domain => 'test',
type => 'informix',
driver => 'Informix',
database => 'test@test',
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'SET LOCK MODE TO WAIT 100',
'SET ISOLATION TO DIRTY READ',
],
);
# Admin
Rose::DB->register_db(
domain => 'test',
type => 'informix_admin',
driver => 'Informix',
database => 'test@test',
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'SET LOCK MODE TO WAIT 100',
'SET ISOLATION TO DIRTY READ',
],
);
#
# SQLite
#
eval
{
local $^W = 0;
require DBD::SQLite;
};
(my $version = $DBD::SQLite::VERSION || 0) =~ s/_//g;
unless($ENV{'RDBO_NO_SQLITE'} || $version < 1.11 || ($version >= 1.13 && $version < 1.1902))
{
#unlink("$Bin/sqlite.db");
# Main
Rose::DB->register_db(
domain => 'test',
type => 'sqlite',
driver => 'sqlite',
database => "$Bin/sqlite.db",
auto_create => 0,
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'PRAGMA synchronous = OFF',
'PRAGMA temp_store = MEMORY',
],
);
# Admin
Rose::DB->register_db(
domain => 'test',
type => 'sqlite_admin',
driver => 'sqlite',
database => "$Bin/sqlite.db",
connect_options => { AutoCommit => 1 },
post_connect_sql =>
[
'PRAGMA synchronous = OFF',
'PRAGMA temp_store = MEMORY',
],
);
}
#
# Oracle
#
# Main
Rose::DB->register_db(
domain => 'test',
type => 'oracle',
driver => 'oracle',
database => 'test@test',
connect_options => { AutoCommit => 1 },
);
# Admin
Rose::DB->register_db(
domain => 'test',
type => 'oracle_admin',
driver => 'oracle',
database => 'test@test',
connect_options => { AutoCommit => 1 },
);
my @types = qw(pg pg_with_schema pg_admin mysql mysql_admin
informix informix_admin oracle oracle_admin);
unless($Rose::DB::Object::Test::NoDefaults)
{
foreach my $db_type (qw(PG MYSQL INFORMIX ORACLE))
{
if(my $dsn = $ENV{"RDBO_${db_type}_DSN"})
{
foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
{
Rose::DB->modify_db(domain => 'test', type => $type, dsn => $dsn);
}
}
if(my $user = $ENV{"RDBO_${db_type}_USER"})
{
foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
{
Rose::DB->modify_db(domain => 'test', type => $type, username => $user);
}
}
if(my $user = $ENV{"RDBO_${db_type}_PASS"})
{
foreach my $type (grep { /^$db_type(?:_|$)/i } @types)
{
Rose::DB->modify_db(domain => 'test', type => $type, password => $user);
}
}
}
}
}
package main;
my %Have_DB;
sub get_db
{
my($type) = shift;
if((defined $Have_DB{$type} && !$Have_DB{$type}) || !get_dbh($type))
{
return undef;
}
return Rose::DB->new($type);
}
sub get_dbh
{
my($type) = shift;
my $dbh;
local $@;
eval
{
$dbh = Rose::DB->new($type)->retain_dbh()
or die Rose::DB->error;
};
if(!$@ && $dbh)
{
$Have_DB{$type} = 1;
return $dbh;
}
return $Have_DB{$type} = 0;
}
sub have_db
{
my($type) = shift;
if($type =~ /^sqlite(?:_admin)$/ && $ENV{'RDBO_NO_SQLITE'})
{
return $Have_DB{$type} = 0;
}
return $Have_DB{$type} = shift if(@_);
return $Have_DB{$type} if(exists $Have_DB{$type});
return get_dbh($type) ? 1 : 0;
}
sub mysql_supports_innodb
{
my $db = get_db('mysql_admin') or return 0;
eval
{
my $dbh = $db->dbh;
CLEAR:
{
local $dbh->{'RaiseError'} = 0;
local $dbh->{'PrintError'} = 0;
$dbh->do('DROP TABLE rdbo_innodb_test');
}
$dbh->do(<<"EOF");
CREATE TABLE rdbo_innodb_test
(
id INTEGER PRIMARY KEY
)
ENGINE=InnoDB
EOF
# MySQL will silently ignore the "ENGINE=InnoDB" part and create
# a MyISAM table instead. MySQL is evil! Now we have to manually
# check to make sure an InnoDB table was really created.
my $db_name = $db->database;
my $sth = $dbh->prepare("SHOW TABLE STATUS FROM `$db_name` LIKE ?");
$sth->execute('rdbo_innodb_test');
my $info = $sth->fetchrow_hashref;
no warnings 'uninitialized';
unless(lc $info->{'Type'} eq 'innodb' || lc $info->{'Engine'} eq 'innodb')
{
die "Missing InnoDB support";
}
$dbh->do('DROP TABLE rdbo_innodb_test');
};
if($@)
{
warn $@ unless($@ =~ /Missing InnoDB support/);
return 0;
}
return 1;
}
our $PG_HAS_CHKPASS = $ENV{'PG_HAS_CHKPASS'};
sub pg_has_chkpass
{
return $PG_HAS_CHKPASS if(defined $PG_HAS_CHKPASS);
my $dbh = get_dbh('pg_admin') or return undef;
eval
{
local $dbh->{'RaiseError'} = 1;
local $dbh->{'PrintError'} = 0;
$dbh->do('CREATE TABLE rose_db_object_chkpass_test (pass CHKPASS)');
$dbh->do('DROP TABLE rose_db_object_chkpass_test');
};
return $PG_HAS_CHKPASS = $@ ? 0 : 1;
}
our $PG_MAX_CONNECTIONS;
sub pg_max_connections
{
return $PG_MAX_CONNECTIONS if(defined $PG_MAX_CONNECTIONS);
my $dbh = get_dbh('pg') or return 0;
my @dbh = ($dbh);
for(;;)
{
eval { $dbh = get_dbh('pg') or die; push(@dbh, $dbh) };
last if($@ || @dbh > 50);
}
return $PG_MAX_CONNECTIONS = @dbh;
}
sub oracle_is_broken
{
return undef unless(have_db('oracle'));
my $db = get_db('oracle');
# This particular version of Oracle 10g on Mac OS X is broken
return ($db->database_version == 100010300 && $^O =~ /darwin/i) ? 1 : 0;
}
our $HAVE_TEST_MEMORY_CYCLE;
eval
{
require Test::Memory::Cycle;
$HAVE_TEST_MEMORY_CYCLE = 1;
};
sub test_memory_cycle_ok
{
my($val, $msg) = @_;
$HAVE_TEST_MEMORY_CYCLE ?
Test::Memory::Cycle::memory_cycle_ok($val, $msg) :
Test::More::ok(1, "$msg (skipped)");
}
my %Column_Args =
(
enum => [ values => [ 'a' .. 'z' ] ],
);
sub nonpersistent_column_definitions
{
my @columns;
my $i = 1;
foreach my $type (Rose::DB::Object::Metadata->column_type_names)
{
next if($type =~ /(?:chkpass| to |serial|array|\bset\b)/);
push(@columns, 'np' . $i++ => { type => $type, smart_modification => 0,
temp => 1, @{ $Column_Args{$type} || [] } });
}
return @columns;
}
sub modify_nonpersistent_column_values
{
my($object) = shift;
foreach my $column ($object->meta->nonpersistent_columns)
{
my $method = $column->mutator_method_name;
$object->$method(undef); # with smart modification off, this should be sufficient
}
}
sub add_nonpersistent_columns_and_methods
{
my($class) = shift;
my $meta = $class->meta;
$meta->add_columns(nonpersistent_column_definitions());
$meta->make_nonpersistent_column_methods();
}
1;