Commit | Line | Data |
18360aed |
1 | package DBIx::Class::Storage::DBI::Oracle::Generic; |
e21dfd6a |
2 | # -*- mode: cperl; cperl-indent-level: 2 -*- |
18360aed |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Carp::Clan qw/^DBIx::Class/; |
8 | |
9 | use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; |
10 | |
11 | # __PACKAGE__->load_components(qw/PK::Auto/); |
12 | |
13 | sub _dbh_last_insert_id { |
14 | my ($self, $dbh, $source, $col) = @_; |
15 | my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); |
16 | my $sql = 'SELECT ' . $seq . '.currval FROM DUAL'; |
17 | my ($id) = $dbh->selectrow_array($sql); |
18 | return $id; |
19 | } |
20 | |
21 | sub _dbh_get_autoinc_seq { |
22 | my ($self, $dbh, $source, $col) = @_; |
23 | |
24 | # look up the correct sequence automatically |
25 | my $sql = q{ |
26 | SELECT trigger_body FROM ALL_TRIGGERS t |
27 | WHERE t.table_name = ? |
28 | AND t.triggering_event = 'INSERT' |
29 | AND t.status = 'ENABLED' |
30 | }; |
31 | |
32 | # trigger_body is a LONG |
33 | $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024); |
34 | |
35 | my $sth = $dbh->prepare($sql); |
36 | $sth->execute( uc($source->name) ); |
37 | while (my ($insert_trigger) = $sth->fetchrow_array) { |
38 | return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here??? |
39 | } |
40 | croak "Unable to find a sequence INSERT trigger on table '" . $source->name . "'."; |
41 | } |
42 | |
43 | sub get_autoinc_seq { |
44 | my ($self, $source, $col) = @_; |
45 | |
46 | $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col); |
47 | } |
48 | |
49 | sub columns_info_for { |
50 | my ($self, $table) = @_; |
51 | |
52 | $self->next::method(uc($table)); |
53 | } |
54 | |
55 | |
56 | 1; |
57 | |
58 | =head1 NAME |
59 | |
60 | DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle |
61 | |
62 | =head1 SYNOPSIS |
63 | |
64 | # In your table classes |
65 | __PACKAGE__->load_components(qw/PK::Auto Core/); |
66 | __PACKAGE__->set_primary_key('id'); |
67 | __PACKAGE__->sequence('mysequence'); |
68 | |
69 | =head1 DESCRIPTION |
70 | |
71 | This class implements autoincrements for Oracle. |
72 | |
73 | =head1 AUTHORS |
74 | |
75 | Andy Grundman <andy@hybridized.org> |
76 | |
77 | Scott Connelly <scottsweep@yahoo.com> |
78 | |
79 | =head1 LICENSE |
80 | |
81 | You may distribute this code under the same terms as Perl itself. |
82 | |
83 | =cut |