/modules/Rose-DB-Object/t/test-lib.pl

#!/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;