lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm

   1 package DBIx::Class::Storage::DBI::Oracle::Generic;
   2 # -*- mode: cperl; cperl-indent-level: 2 -*-
   3
   4 use strict;
   5 use warnings;
   6
   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
  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   }
  59   $self->throw_exception("Unable to find a sequence INSERT trigger on table '" . $source->name . "'.");
  60 }
  61
  62 =head2 get_autoinc_seq
  63
  64 Returns the sequence name for an autoincrement column
  65
  66 =cut
  67
  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
  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
  81 sub columns_info_for {
  82   my ($self, $table) = @_;
  83
  84   $self->next::method(uc($table));
  85 }
  86
  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
  98
  99 1;