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