view release on metacpan or  search on metacpan

t/10-oracle.t  view on Meta::CPAN

  __PACKAGE__->add_columns(
    'artistid' => {
      data_type         => 'integer',
      is_auto_increment => 1,
    },
    'name' => {
      data_type   => 'varchar',
      size        => 100,
      is_nullable => 1,
    },
    'autoinc_col' => {
      data_type         => 'integer',
      is_auto_increment => 1,
    },
    'default_value_col' => {
      data_type           => 'varchar',
      size                => 100,
      is_nullable         => 0,
      retrieve_on_insert  => 1,
    }
  );
  __PACKAGE__->set_primary_key(qw/ artistid autoinc_col /);

  1;
}

DBIO::Test::Schema->load_classes('ArtistFQN');

# SequenceTest lives in the DBIO::Oracle::Test namespace, not under the schema's
# own result namespace, so register it explicitly under the 'SequenceTest' moniker.
DBIO::Test::Schema->register_class('SequenceTest', 'DBIO::Oracle::Test::SequenceTest');

# This is in Core now, but it's here just to test that it doesn't break
DBIO::Test::Schema::Artist->load_components('PK::Auto');
# These are compat shims for PK::Auto...
DBIO::Test::Schema::CD->load_components('PK::Auto::Oracle');
DBIO::Test::Schema::Track->load_components('PK::Auto::Oracle');


# check if we indeed do support stuff
my $v = do {
  my $si = DBIO::Test::Schema->connect($dsn, $user, $pass)->storage->_server_info;
  $si->{normalized_dbms_version}
    or die "Unparseable Oracle server version: $si->{dbms_version}\n";
};

my $test_server_supports_only_orajoins = $v < 9;

# TODO find out which version supports the RETURNING syntax
# 8i (8.1) has it and earlier docs are a 404 on oracle.com
my $test_server_supports_insert_returning = $v >= 8.001;

is (
  DBIO::Test::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
  $test_server_supports_insert_returning,
  'insert returning capability guessed correctly'
);

isa_ok (DBIO::Test::Schema->connect($dsn, $user, $pass)->storage->sql_maker, 'DBIO::Oracle::SQLMaker');

# see if determining a driver with bad credentials throws propely
# (sql_maker is lazy and never connects -- ensure_connected forces the connect)
throws_ok {
  DBIO::Test::Schema->connect($dsn, "BORKED BORKED USER $user", $pass)->storage->ensure_connected;
} qr/DBI Connection failed/;

##########
# the recyclebin (new for 10g) sometimes comes in the way
my $on_connect_sql = $v >= 10 ? ["ALTER SESSION SET recyclebin = OFF"] : [];

# iterate all tests on following options
my @tryopt = (
  { on_connect_do => $on_connect_sql },
  { quote_char => '"', on_connect_do => $on_connect_sql },
);

# keep a database handle open for cleanup
my ($dbh, $dbh2);

my $schema;
for my $use_insert_returning ($test_server_supports_insert_returning ? (1,0) : (0) ) {
  for my $force_ora_joins ($test_server_supports_only_orajoins ? (0) : (0,1) ) {

    no warnings qw/once redefine/;
    my $old_connection = DBIO::Test::Schema->can('connection');
    local *DBIO::Test::Schema::connection = subname 'DBIO::Test::Schema::connection' => sub {
      my $s = shift->$old_connection (@_);
      $s->storage->_use_insert_returning ($use_insert_returning);
      $s->storage->sql_maker_class('DBIO::Oracle::SQLMaker::Joins') if $force_ora_joins;
      $s;
    };

    for my $opt (@tryopt) {
      # clean all cached sequences from previous run
      for (map { values %{DBIO::Test::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) {
        delete $_->{sequence};
      }

      my $schema = DBIO::Test::Schema->connect($dsn, $user, $pass, $opt);

      $dbh = $schema->storage->dbh;
      my $q = $schema->storage->sql_maker->quote_char || '';

      do_creates($dbh, $q);

      _run_tests($schema, $opt);
    }
  }
}

sub _run_tests {
  my ($schema, $opt) = @_;

  my $q = $schema->storage->sql_maker->quote_char || '';

# test primary key handling with multiple triggers
  my ($new, $seq);

  my $new_artist = $schema->resultset('Artist')->create({ name => 'foo' });
  my $new_cd     = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });