More internals cleanup, separated out ResultSourceInstance from TableInstance
[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};
c8f4b52b 13 my $sql = "SELECT " . $self->{_autoinc_seq} . ".currval FROM DUAL";
e565d25e 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);
b98e75f6 37 $sth->execute( uc($self->result_source->name) );
e565d25e 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
6718c5f0 56 # In your table classes
57 __PACKAGE__->load_components(qw/PK::Auto::Oracle Core/);
58 __PACKAGE__->set_primary_key('id');
59
e565d25e 60=head1 DESCRIPTION
61
62This class implements autoincrements for Oracle.
63
64=head1 AUTHORS
65
66Andy Grundman <andy@hybridized.org>
9f19b1d6 67
e565d25e 68Scott Connelly <scottsweep@yahoo.com>
69
70=head1 LICENSE
71
72You may distribute this code under the same terms as Perl itself.
73
74=cut
75