Merge 'trunk' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI / Oracle.pm
1 package DBIx::Class::Storage::DBI::Oracle;
2
3 use strict;
4 use warnings;
5
6 use Carp qw/croak/;
7
8 use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
9
10 # __PACKAGE__->load_components(qw/PK::Auto/);
11
12 sub last_insert_id {
13   my ($self,$source,$col) = @_;
14   my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
15   my $sql = "SELECT " . $seq . ".currval FROM DUAL";
16   my ($id) = $self->_dbh->selectrow_array($sql);
17   return $id;
18 }
19
20 sub get_autoinc_seq {
21   my ($self,$source,$col) = @_;
22     
23   # look up the correct sequence automatically
24   my $dbh = $self->_dbh;
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   # trigger_body is a LONG
32   $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
33   my $sth = $dbh->prepare($sql);
34   $sth->execute( uc($source->name) );
35   while (my ($insert_trigger) = $sth->fetchrow_array) {
36     return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here???
37   }
38   croak "Unable to find a sequence INSERT trigger on table '" . $source->name . "'.";
39 }
40
41 1;
42
43 =head1 NAME
44
45 DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
46
47 =head1 SYNOPSIS
48
49   # In your table classes
50   __PACKAGE__->load_components(qw/PK::Auto Core/);
51   __PACKAGE__->set_primary_key('id');
52   __PACKAGE__->sequence('mysequence');
53
54 =head1 DESCRIPTION
55
56 This class implements autoincrements for Oracle.
57
58 =head1 AUTHORS
59
60 Andy Grundman <andy@hybridized.org>
61
62 Scott Connelly <scottsweep@yahoo.com>
63
64 =head1 LICENSE
65
66 You may distribute this code under the same terms as Perl itself.
67
68 =cut