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