Make pg sequence autodetect deterministic (or throw exceptions). Test needs adjusting

diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index f6554e0..0818aa7 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -57,7 +57,7 @@ sub _get_pg_search_path {
 }
 
 sub _dbh_get_autoinc_seq {
-  my ($self, $dbh, $schema, $table, @pri) = @_;
+  my ($self, $dbh, $schema, $table, $col) = @_;
 
   # get the list of postgres schemas to search.  if we have a schema
   # specified, use that.  otherwise, use the search path
@@ -68,51 +68,68 @@ sub _dbh_get_autoinc_seq {
       @search_path = @{ $self->_get_pg_search_path($dbh) };
   }
 
+  # find the sequence(s) of the column in question (should have nextval declared on it)
+  my @sequence_names;
   foreach my $search_schema (@search_path) {
-      foreach my $col (@pri) {
-          my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
-          if($info) {
-              # if we get here, we have definitely found the right
-              # column.
-              if( defined $info->{COLUMN_DEF} and
-                  $info->{COLUMN_DEF}
-                    =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
-                ) {
-                  my $seq = $1;
-
-                  # have not figured out a 100% reliable way to tell
-                  # what sequence is meant if it is not
-                  # schema-qualified.  see TODO tests in 72pg.t
-                  if( $seq =~ /\./ ) {
-                      return $seq;
-                  } else {
-                      # this guess is going to be incorrect some of
-                      # the time, which could lead to problems that
-                      # could be pretty hairy to trace.  thus the
-                      # warning.
-                      $seq = $info->{TABLE_SCHEM} . "." . $seq;
-                      warn "WARNING: guessing sequence '$seq' for key $search_schema.$table.$col\n";
-                      return $seq;
-                  }
-
-                  # return our (schema-qualified) seq
-                  return $seq;
-              } else {
-                  # we have found the column, but cannot figure out
-                  # the nextval seq
-                  return;
-              }
-          }
-      }
+    my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
+    if($info && defined $info->{COLUMN_DEF}
+             && $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
+    ) {
+        push @sequence_names, $1;
+    }
   }
-  return;
+
+  if (@sequence_names != 1) {
+    $self->throw_exception (sprintf
+      q|Unable to reliably determine autoinc sequence name for '%s'.'%s' (possible candidates: %s)|,
+      $table,
+      $col,
+      join (', ', (@sequence_names ? @sequence_names : 'none found') ),
+    );
+  }
+
+  my $seq = $sequence_names[0];
+
+  if( $seq !~ /\./ ) {
+    my $sth = $dbh->prepare (
+      'SELECT * FROM "information_schema"."sequences" WHERE "sequence_name" = ?'
+    );
+    $sth->execute ($seq);
+
+    my @seen_in_schemas;
+    while (my $h = $sth->fetchrow_hashref) {
+      push @seen_in_schemas, $h->{sequence_schema};
+    }
+
+    if (not @seen_in_schemas) {
+      $self->throw_exception (sprintf
+        q|Automatically determined autoinc sequence name '%s' for '%s'.'%s' does not seem to exist...'|,
+        $seq,
+        $table,
+        $col,
+      );
+    }
+    elsif (@seen_in_schemas > 1) {
+      $self->throw_exception (sprintf
+        q|Unable to reliably fully-qualify automatically determined autoinc sequence name '%s' for '%s'.'%s' (same name exist in schemas: %s)|,
+        $seq,
+        $table,
+        $col,
+        join (', ', (@seen_in_schemas)),
+      );
+    }
+    else {
+      my $sql_maker = $self->sql_maker;
+      $seq = join ('.', map { $sql_maker->_quote ($_) } ($seen_in_schemas[0], $seq) );
+    }
+  }
+
+  return $seq;
 }
 
 sub get_autoinc_seq {
   my ($self,$source,$col) = @_;
 
-  my @pri = $source->primary_columns;
-
   my $schema;
   my $table = $source->name;
 
@@ -123,7 +140,7 @@ sub get_autoinc_seq {
     ($schema, $table) = ($1, $2);
   }
 
-  $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
+  $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, $col);
 }
 
 sub sqlt_type {

diff --git a/t/72pg.t b/t/72pg.t
index 9f2df92..c73c331 100644 (file)
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -2,7 +2,6 @@ use strict;
 use warnings;
 
 use Test::More;
-use Test::Warn;
 use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
@@ -186,34 +185,27 @@ cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an
                       [qw| unq_nextval_schema   2 |],
                       [qw| unq_nextval_schema2  1 |],
                      );
-  TODO: {
-    local $TODO = 'have not figured out a 100% reliable way to tell which schema an unqualified seq is in';
-    warnings_exist (
-      sub {
-        foreach my $t ( @todo_schemas ) {
-          my ($sch_name, $start_num) = @$t;
-          #test with anothertestschema
-          $schema->source('Artist')->name("$sch_name.artist");
-          $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
-          my $another_new;
-          lives_ok {
-            $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
-            is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
-              or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
-          } "$sch_name liid 1 did not die"
-            or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 
-          lives_ok {
-            $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
-            is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
-              or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
-          } "$sch_name liid 2 did not die"
-            or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
-        }
-      },
-      [ (qr/guessing sequence/)x2],
-      'got a bunch of warnings from unqualified schema guessing'
-    );
+  foreach my $t ( @todo_schemas ) {
+    my ($sch_name, $start_num) = @$t;
+
+    #test with anothertestschema
+    $schema->source('Artist')->name("$sch_name.artist");
+    $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
+    my $another_new;
+    lives_ok {
+      $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
+      is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
+        or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+    } "$sch_name liid 1 did not die"
+      or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+
+    lives_ok {
+      $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
+      is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
+        or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+    } "$sch_name liid 2 did not die"
+      or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
   }
 
   $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache