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