[Bast-commits] r7458 - DBIx-Class/0.08/branches/pg_unqualified_schema/lib/DBIx/Class/Storage/DBI

[rbuels at dev.catalyst.perl.org]

Author: rbuels
Date: 2009-09-01 10:54:34 +0000 (Tue, 01 Sep 2009)
New Revision: 7458

Modified:
   DBIx-Class/0.08/branches/pg_unqualified_schema/lib/DBIx/Class/Storage/DBI/Pg.pm
Log:
in Pg storage, added a warning for case when the nextval sequence is not schema qualified

Modified: DBIx-Class/0.08/branches/pg_unqualified_schema/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/pg_unqualified_schema/lib/DBIx/Class/Storage/DBI/Pg.pm	2009-09-01 10:51:31 UTC (rev 7457)
+++ DBIx-Class/0.08/branches/pg_unqualified_schema/lib/DBIx/Class/Storage/DBI/Pg.pm	2009-09-01 10:54:34 UTC (rev 7458)
@@ -21,10 +21,12 @@
 
 sub last_insert_id {
   my ($self,$source,$col) = @_;
-  my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
-  $self->throw_exception("could not fetch primary key for " . $source->name . ", could not "
-    . "get autoinc sequence for $col (check that table and column specifications are correct "
-    . "and in the correct case)") unless defined $seq;
+  my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col))
+      or $self->throw_exception( "could not determine sequence for "
+                                 . $source->name
+                                 . ".$col, please consider adding a "
+                                 . "schema-qualified sequence to its column info"
+                               );
 
   $self->_dbh_last_insert_id ($self->_dbh, $seq);
 }
@@ -77,7 +79,24 @@
                     =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
                 ) {
                   my $seq = $1;
-                  return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
+
+                  # 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