The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;

use FindBin qw($Bin);

use Rose::DB;

BEGIN
{
  Rose::DB->default_domain('test');

  #
  # PostgreSQL
  #

  # Main
  Rose::DB->register_db(
    domain   => 'test',
    type     => 'pg',
    driver   => 'pg',
    database => 'test',
    host     => 'localhost',
    username => 'postgres',
    password => '',
    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 => '',
    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 => '',
    post_connect_sql =>
    [
      'SET default_transaction_isolation TO "read committed"',
    ],
  );

  #
  # Oracle
  #

  # Main
  Rose::DB->register_db(
    domain   => 'test',
    type     => 'oracle',
    driver   => 'oracle',
    database => 'test',
    host     => 'localhost',
    username => '',
    password => '',
    post_connect_sql =>
    [
      "alter session set nls_timestamp_format = 'YYYY-MM-DD HH24:MI:SS'",
    ],
  );

  # Admin
  Rose::DB->register_db(
    domain   => 'test',
    type     => 'oracle_admin',
    driver   => 'oracle',
    database => 'test',
    host     => 'localhost',
    username => '',
    password => '',
    post_connect_sql =>
    [
      "alter session set nls_timestamp_format = 'YYYY-MM-DD HH24:MI:SS'",
    ],
  );

  #
  # 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, 
      ((rand() < 0.5) ? (FetchHashKeyName => 'NAME_lc') : ()),
    },
    post_connect_sql =>
    [
      'SET LOCK MODE TO WAIT 60',
      'SET ISOLATION TO DIRTY READ',
    ],
  );

  # Admin
  Rose::DB->register_db(
    domain   => 'test',
    type     => 'informix_admin',
    driver   => 'Informix',
    database => 'test@test',
    connect_options => 
    {
      AutoCommit => 1, 
      ((rand() < 0.5) ? (FetchHashKeyName => 'NAME_lc') : ()),
    },
    post_connect_sql =>
    [
      'SET LOCK MODE TO WAIT 60',
      'SET ISOLATION TO DIRTY READ',
    ],
  );

  # Just test that the catalog attribute works.  No supported DBs use it.
  Rose::DB->register_db(
    domain   => 'catalog_test',
    type     => 'catalog_test',
    driver   => 'pg',
    database => 'test',
    catalog  => 'somecatalog',
    schema   => 'someschema',
    host     => 'localhost',
    username => 'postgres',
    password => '',
  );

  #
  # 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))
  {
    # Main
    Rose::DB->register_db(
      domain   => 'test',
      type     => 'sqlite',
      driver   => 'sqlite',
      database => "$Bin/sqlite.db",
      auto_create     => 0,
      connect_options => 
      {
        AutoCommit => 1, 
        ((rand() < 0.5) ? (FetchHashKeyName => 'NAME_lc') : ()),
      },
      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, 
        ((rand() < 0.5) ? (FetchHashKeyName => 'NAME_lc') : ()),
      },
      post_connect_sql =>
      [
        'PRAGMA synchronous = OFF',
        'PRAGMA temp_store = MEMORY',
      ],
    );
  }

  my @types = qw(oracle oracle_admin pg pg_with_schema pg_admin mysql mysql_admin
                 informix informix_admin sqlite sqlite_admin);

  unless($Rose::DB::Object::Test::NoDefaults)
  {
    foreach my $db_type (qw(ORACLE PG MYSQL INFORMIX))
    {
      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);
        }
      }
    }
  }
}

Rose::DB->load_driver_classes(qw(ORAcle pg MySQL informix SQLItE));

# Subclass testing
package My::DB;
@My::DB::ISA = qw(Rose::DB);

package My::DB2;
@My::DB2::ISA = qw(My::DB);

sub init_dbh
{
  my($self) = shift;
  $My::DB2::Called{'init_dbh'}++;
  $self->SUPER::init_dbh(@_);
}

package My::DB2::Oracle;
@My::DB2::Oracle::ISA = qw(Rose::DB::Oracle);

sub subclass_special_oracle { 'ORACLE' }

package My::DB2::Pg;
@My::DB2::Pg::ISA = qw(Rose::DB::Pg);

sub subclass_special_pg { 'PG' }

package My::DB2::MySQL;
@My::DB2::MySQL::ISA = qw(Rose::DB::MySQL);

sub subclass_special_mysql { 'MYSQL' }

package My::DB2::Informix;
@My::DB2::Informix::ISA = qw(Rose::DB::Informix);

sub subclass_special_informix { 'INFORMIX' }

My::DB2->driver_class(Oracle => 'My::DB2::Oracle');
My::DB2->driver_class(Pg => 'My::DB2::Pg');
My::DB2->driver_class(mysql => 'My::DB2::MySQL');
My::DB2->driver_class(Informix => 'My::DB2::Informix');

package My::DB3;
@My::DB3::ISA = qw(My::DB2);

My::DB3->use_private_registry;

package My::DBReg;
@My::DBReg::ISA = qw(Rose::DB);

My::DBReg->registry(Rose::DB::Registry->new);

My::DBReg->register_db(
  domain   => 'test',
  type     => 'pg_sub',
  driver   => 'Pg',
  database => 'test_sub',
  host     => 'subhost',
  username => 'subuser');

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;

  eval 
  {
    my $db = Rose::DB->new($type);
    $db->print_error(0);
    $dbh = $db->retain_dbh or die Rose::DB->error;
    $db->print_error(1);
  };

  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;
}

1;