Make pg sequence autodetect deterministic (or throw exceptions). Test needs adjusting
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Pg.pm
index f6554e0..0818aa7 100644 (file)
@@ -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 {