Preparing for 0.02 release
[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
5b34b2f9 22 if ($self->sequence) {
23 return $self->{_autoinc_seq} = $self->sequence;
24 }
e565d25e 25
26 # look up the correct sequence automatically
27 my $dbh = $self->storage->dbh;
28 my $sql = qq{
29 SELECT trigger_body FROM ALL_TRIGGERS t
30 WHERE t.table_name = ?
31 AND t.triggering_event = 'INSERT'
32 AND t.status = 'ENABLED'
33 };
34 # trigger_body is a LONG
35 $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
36 my $sth = $dbh->prepare($sql);
37 $sth->execute( uc($self->_table_name) );
38 while (my ($insert_trigger) = $sth->fetchrow_array) {
39 if ($insert_trigger =~ m!(\w+)\.nextval!i ) {
40 $self->{_autoinc_seq} = uc($1);
41 }
42 }
43 unless ($self->{_autoinc_seq}) {
44 die "Unable to find a sequence INSERT trigger on table '" . $self->_table_name . "'.";
45 }
46}
47
481;
49
50=head1 NAME
51
52DBIx::Class::PK::Auto::Oracle - Automatic Primary Key class for Oracle
53
54=head1 SYNOPSIS
55
56=head1 DESCRIPTION
57
58This class implements autoincrements for Oracle.
59
60=head1 AUTHORS
61
62Andy Grundman <andy@hybridized.org>
9f19b1d6 63
e565d25e 64Scott Connelly <scottsweep@yahoo.com>
65
66=head1 LICENSE
67
68You may distribute this code under the same terms as Perl itself.
69
70=cut
71