Added Oracle PK::Auto, with sequence lookup
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / PK / Auto / Oracle.pm
CommitLineData
e565d25e 1package DBIx::Class::PK::Auto::Oracle;
2
3use strict;
4use warnings;
5
6use base qw/DBIx::Class/;
7
8__PACKAGE__->load_components(qw/PK::Auto/);
9
10sub last_insert_id {
11 my $self = shift;
12 $self->get_autoinc_seq unless $self->{_autoinc_seq};
13 my $sql = "SELECT " . $self->{_autoinc_seq} . ".nextval FROM DUAL";
14 my ($id) = $self->storage->dbh->selectrow_array($sql);
15 return $id;
16}
17
18sub get_autoinc_seq {
19 my $self = shift;
20
21 # return the user-defined sequence if known
22 return $self->sequence if ($self->sequence);
23
24 # look up the correct sequence automatically
25 my $dbh = $self->storage->dbh;
26 my $sql = qq{
27 SELECT trigger_body FROM ALL_TRIGGERS t
28 WHERE t.table_name = ?
29 AND t.triggering_event = 'INSERT'
30 AND t.status = 'ENABLED'
31 };
32 # trigger_body is a LONG
33 $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
34 my $sth = $dbh->prepare($sql);
35 $sth->execute( uc($self->_table_name) );
36 while (my ($insert_trigger) = $sth->fetchrow_array) {
37 if ($insert_trigger =~ m!(\w+)\.nextval!i ) {
38 $self->{_autoinc_seq} = uc($1);
39 }
40 }
41 unless ($self->{_autoinc_seq}) {
42 die "Unable to find a sequence INSERT trigger on table '" . $self->_table_name . "'.";
43 }
44}
45
461;
47
48=head1 NAME
49
50DBIx::Class::PK::Auto::Oracle - Automatic Primary Key class for Oracle
51
52=head1 SYNOPSIS
53
54=head1 DESCRIPTION
55
56This class implements autoincrements for Oracle.
57
58=head1 AUTHORS
59
60Andy Grundman <andy@hybridized.org>
61Scott Connelly <scottsweep@yahoo.com>
62
63=head1 LICENSE
64
65You may distribute this code under the same terms as Perl itself.
66
67=cut
68