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/;
   9
  10 # __PACKAGE__->load_components(qw/PK::Auto/);
  11
  12 sub last_insert_id {
  13   my ($self, $source) = shift;
  14   $self->get_autoinc_seq($source) unless $source->{_autoinc_seq};
  15   my $sql = "SELECT " . $source->{_autoinc_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) = @_;
  22
  23   # return the user-defined sequence if known
  24   my $result_class = $source->result_class;
  25   if ($result_class->can('sequence') and $result_class->sequence) {
  26     return ($source->{_autoinc_seq} = $result_class->sequence);
  27   }
  28
  29   # look up the correct sequence automatically
  30   my $dbh = $self->_dbh;
  31   my $sql = qq{
  32     SELECT trigger_body FROM ALL_TRIGGERS t
  33     WHERE t.table_name = ?
  34     AND t.triggering_event = 'INSERT'
  35     AND t.status = 'ENABLED'
  36   };
  37   # trigger_body is a LONG
  38   $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
  39   my $sth = $dbh->prepare($sql);
  40   $sth->execute( uc($source->name) );
  41   while (my ($insert_trigger) = $sth->fetchrow_array) {
  42     if ($insert_trigger =~ m!(\w+)\.nextval!i ) {
  43       $source->{_autoinc_seq} = uc($1);
  44     }
  45   }
  46   unless ($source->{_autoinc_seq}) {
  47     croak "Unable to find a sequence INSERT trigger on table '" . $self->_table_name . "'.";
  48   }
  49 }
  50
  51 1;
  52
  53 =head1 NAME
  54
  55 DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
  56
  57 =head1 SYNOPSIS
  58
  59   # In your table classes
  60   __PACKAGE__->load_components(qw/PK::Auto Core/);
  61   __PACKAGE__->set_primary_key('id');
  62   __PACKAGE__->sequence('mysequence');
  63
  64 =head1 DESCRIPTION
  65
  66 This class implements autoincrements for Oracle.
  67
  68 =head1 AUTHORS
  69
  70 Andy Grundman <andy@hybridized.org>
  71
  72 Scott Connelly <scottsweep@yahoo.com>
  73
  74 =head1 LICENSE
  75
  76 You may distribute this code under the same terms as Perl itself.
  77
  78 =cut