Commit | Line | Data |
e565d25e |
1 | package DBIx::Class::PK::Auto::Oracle; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base qw/DBIx::Class/; |
7 | |
8 | __PACKAGE__->load_components(qw/PK::Auto/); |
9 | |
10 | sub 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 | |
18 | sub 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 | |
46 | 1; |
47 | |
48 | =head1 NAME |
49 | |
50 | DBIx::Class::PK::Auto::Oracle - Automatic Primary Key class for Oracle |
51 | |
52 | =head1 SYNOPSIS |
53 | |
54 | =head1 DESCRIPTION |
55 | |
56 | This class implements autoincrements for Oracle. |
57 | |
58 | =head1 AUTHORS |
59 | |
60 | Andy Grundman <andy@hybridized.org> |
61 | Scott Connelly <scottsweep@yahoo.com> |
62 | |
63 | =head1 LICENSE |
64 | |
65 | You may distribute this code under the same terms as Perl itself. |
66 | |
67 | =cut |
68 | |