Added Oracle PK::Auto, with sequence lookup

diff --git a/lib/DBIx/Class/PK/Auto/Oracle.pm b/lib/DBIx/Class/PK/Auto/Oracle.pm
new file mode 100644 (file)
index 0000000..40f4190
--- /dev/null
+++ b/lib/DBIx/Class/PK/Auto/Oracle.pm
@@ -0,0 +1,68 @@
+package DBIx::Class::PK::Auto::Oracle;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id {
+  my $self = shift;
+  $self->get_autoinc_seq unless $self->{_autoinc_seq};
+  my $sql = "SELECT " . $self->{_autoinc_seq} . ".nextval FROM DUAL";
+  my ($id) = $self->storage->dbh->selectrow_array($sql);
+  return $id;  
+}
+
+sub get_autoinc_seq {
+  my $self = shift;
+  
+  # return the user-defined sequence if known
+  return $self->sequence if ($self->sequence);
+  
+  # look up the correct sequence automatically
+  my $dbh = $self->storage->dbh;
+  my $sql = qq{
+    SELECT trigger_body FROM ALL_TRIGGERS t
+    WHERE t.table_name = ?
+    AND t.triggering_event = 'INSERT'
+    AND t.status = 'ENABLED'
+  };
+  # trigger_body is a LONG
+  $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+  my $sth = $dbh->prepare($sql);
+  $sth->execute( uc($self->_table_name) );
+  while (my ($insert_trigger) = $sth->fetchrow_array) {
+    if ($insert_trigger =~ m!(\w+)\.nextval!i ) {
+      $self->{_autoinc_seq} = uc($1);
+    }
+  }
+  unless ($self->{_autoinc_seq}) {
+    die "Unable to find a sequence INSERT trigger on table '" . $self->_table_name . "'.";
+  }
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::PK::Auto::Oracle - Automatic Primary Key class for Oracle
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for Oracle.
+
+=head1 AUTHORS
+
+Andy Grundman <andy@hybridized.org>
+Scott Connelly <scottsweep@yahoo.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+

diff --git a/t/13oracle.t b/t/13oracle.t
new file mode 100644 (file)
index 0000000..b031ab3
--- /dev/null
+++ b/t/13oracle.t
@@ -0,0 +1,47 @@
+use lib qw(lib t/lib);
+use DBICTest::Schema;
+
+use Test::More;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
+
+plan skip_all, 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' .
+  'Warning: This test drops and creates a table called \'artist\''
+  unless ($dsn && $user && $pass);
+
+plan tests => 1;
+
+DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass);
+
+my $dbh = OraTest::Artist->storage->dbh;
+
+eval {
+  $dbh->do("DROP SEQUENCE artist_seq");
+  $dbh->do("DROP TABLE artist");
+};
+$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
+$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255))");
+$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
+$dbh->do(qq{
+  CREATE OR REPLACE TRIGGER artist_insert_trg
+  BEFORE INSERT ON artist
+  FOR EACH ROW
+  BEGIN
+    IF :new.artistid IS NULL THEN
+      SELECT artist_seq.nextval
+      INTO :new.artistid
+      FROM DUAL;
+    END IF;
+  END;
+});
+
+OraTest::Artist->load_components('PK::Auto::Oracle');
+
+my $new = OraTest::Artist->create({ name => 'foo' });
+
+ok($new->artistid, "Oracle Auto-PK worked");
+
+$dbh->do("DROP SEQUENCE artist_seq");
+$dbh->do("DROP TABLE artist");
+
+1;