view release on metacpan or  search on metacpan

t/73oracle.t  view on Meta::CPAN

    $ENV{DBICTEST_ORA_USER}
      ? (uc $ENV{DBICTEST_ORA_USER}) . '.artist'
      : '??_no_user_??'
  );
  __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;
}

DBICTest::Schema->load_classes('ArtistFQN');

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


# check if we indeed do support stuff
my $v = do {
  my $si = DBICTest::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 (
  DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
  $test_server_supports_insert_returning,
  'insert returning capability guessed correctly'
);

isa_ok (DBICTest::Schema->connect($dsn, $user, $pass)->storage->sql_maker, 'DBIx::Class::SQLMaker::Oracle');

# see if determining a driver with bad credentials throws propely
throws_ok {
  DBICTest::Schema->connect($dsn, "BORKED BORKED USER $user", $pass)->storage->sql_maker;
} 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 = DBICTest::Schema->can('connection');
    local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
      my $s = shift->$old_connection (@_);
      $s->storage->_use_insert_returning ($use_insert_returning);
      $s->storage->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins') if $force_ora_joins;
      $s;
    };

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

      my $schema = DBICTest::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' });

  SKIP: {