More robust Oracle autoinc pk sequence detection

When only one trigger could possible match a specific column, the trigger
detection rules can be more lenient.

diff --git a/Changes b/Changes
index ae8ef47..a82659f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,6 +7,8 @@ Revision history for DBIx::Class
     * Fixes
         - Fixed read-only attribute set attempt in ::Storage::Replicated
           (RT#62642)
+        - Fix incomplete logic while detecting correct Oracle sequence
+          on insert
 
 0.08124 2010-10-28 14:23 (UTC)
     * New Features / Changes

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index d976f38..be48f20 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -136,29 +136,89 @@ sub _dbh_get_autoinc_seq {
   my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/;
   my ($sql, @bind) = $sql_maker->select (
     'ALL_TRIGGERS',
-    ['trigger_body', 'table_owner'],
+    [qw/ trigger_body table_owner trigger_name /],
     {
       $schema ? (owner => $schema) : (),
       table_name => $table || $source_name,
-      triggering_event => { -like => '%INSERT%' },
+      triggering_event => { -like => '%INSERT%' },  # this will also catch insert_or_update
+      trigger_type => { -like => '%BEFORE%' },      # we care only about 'before' triggers
       status => 'ENABLED',
      },
   );
-  my $sth = $dbh->prepare($sql);
-  $sth->execute (@bind);
 
-  while (my ($insert_trigger, $schema) = $sth->fetchrow_array) {
-    my ($seq_name) = $insert_trigger =~ m/("?[.\w"]+"?)\.nextval .+ into \s+ :new\.$col/xmsi;
+  # to find all the triggers that mention the column in question a simple
+  # regex grep since the trigger_body above is a LONG and hence not searchable
+  my @triggers = ( map
+    { my %inf; @inf{qw/body schema name/} = @$_; \%inf }
+    ( grep
+      { $_->[0] =~ /\:new\.$col/i }
+      @{ $dbh->selectall_arrayref( $sql, {}, @bind ) }
+    )
+  );
+
+  # extract all sequence names mentioned in each trigger
+  for (@triggers) {
+    $_->{sequences} = [ $_->{body} =~ / ( "? [\.\w\"\-]+ "? ) \. nextval /xig ];
+  }
+
+  my $chosen_trigger;
+
+  # if only one trigger matched things are easy
+  if (@triggers == 1) {
+
+    if ( @{$triggers[0]{sequences}} == 1 ) {
+      $chosen_trigger = $triggers[0];
+    }
+    else {
+      $self->throw_exception( sprintf (
+        "Unable to introspect trigger '%s' for column %s.%s (references multiple sequences). "
+      . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+        $triggers[0]{name},
+        $source_name,
+        $col,
+        $col,
+      ) );
+    }
+  }
+  # got more than one matching trigger - see if we can narrow it down
+  elsif (@triggers > 1) {
 
-    next unless $seq_name;
+    my @candidates = grep
+      { $_->{body} =~ / into \s+ \:new\.$col /xi }
+      @triggers
+    ;
 
-    if ($seq_name !~ /\./) {
-      $seq_name = join '.' => $schema, $seq_name;
+    if (@candidates == 1 && @{$candidates[0]{sequences}} == 1) {
+      $chosen_trigger = $candidates[0];
     }
+    else {
+      $self->throw_exception( sprintf (
+        "Unable to reliably select a BEFORE INSERT trigger for column %s.%s (possibilities: %s). "
+      . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+        $source_name,
+        $col,
+        ( join ', ', map { "'$_->{name}'" } @triggers ),
+        $col,
+      ) );
+    }
+  }
+
+  if ($chosen_trigger) {
+    my $seq_name = $chosen_trigger->{sequences}[0];
+
+    $seq_name = "$chosen_trigger->{schema}.$seq_name"
+      unless $seq_name =~ /\./;
 
     return $seq_name;
   }
-  $self->throw_exception("Unable to find a sequence %INSERT% trigger on table '$source_name'.");
+
+  $self->throw_exception( sprintf (
+    "No suitable BEFORE INSERT triggers found for column %s.%s. "
+  . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+    $source_name,
+    $col,
+    $col,
+  ));
 }
 
 sub _sequence_fetch {

diff --git a/t/73oracle.t b/t/73oracle.t
index f54f0ee..734e411 100644 (file)
--- a/t/73oracle.t
+++ b/t/73oracle.t
@@ -84,9 +84,14 @@ $schema->class('Track')->load_components('PK::Auto::Oracle');
 
 # test primary key handling with multiple triggers
 my $new = $schema->resultset('Artist')->create({ name => 'foo' });
-is($new->artistid, 1, "Oracle Auto-PK worked");
+is($new->artistid, 1, "Oracle Auto-PK worked for sqlt-like trigger");
 
-like ($new->result_source->column_info('artistid')->{sequence}, qr/\.artist_pk_seq$/, 'Correct PK sequence selected');
+like ($new->result_source->column_info('artistid')->{sequence}, qr/\.artist_pk_seq$/, 'Correct PK sequence selected for sqlt-like trigger');
+
+$new = $schema->resultset('CD')->create({ artist => 1, title => 'foo', year => '2003' });
+is($new->cdid, 1, "Oracle Auto-PK worked for custom trigger");
+
+like ($new->result_source->column_info('cdid')->{sequence}, qr/\.cd_seq$/, 'Correct PK sequence selected for custom trigger');
 
 # test again with fully-qualified table name
 my $artistfqn_rs = $schema->resultset('ArtistFQN');
@@ -120,7 +125,7 @@ is( $it->next->name, "Artist 6", "iterator->next ok" );
 is( $it->next, undef, "next past end of resultset ok" );
 
 my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });
-is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name");
+is($cd->cdid, 2, "Oracle Auto-PK worked - using scalar ref as table name");
 
 # test rel names over the 30 char limit
 {
@@ -131,7 +136,7 @@ is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name");
   });
 
   lives_and {
-    is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
+    is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 2
   } 'query with rel name over 30 chars survived and worked';
 
   # rel name over 30 char limit with user condition
@@ -831,11 +836,18 @@ sub do_creates {
     CREATE OR REPLACE TRIGGER cd_insert_trg
     BEFORE INSERT OR UPDATE ON cd
     FOR EACH ROW
+    DECLARE
+    tmpVar NUMBER;
+
     BEGIN
+      tmpVar := 0;
+
       IF :new.cdid IS NULL THEN
         SELECT cd_seq.nextval
-        INTO :new.cdid
-        FROM DUAL;
+        INTO tmpVar
+        FROM dual;
+
+        :new.cdid := tmpVar;
       END IF;
     END;
   });