[Dbix-class] Pg patch from konobi - can people test please?

[Matt S Trout]

konobi's lobbed together a patch for Storage::DBI::Pg that hopefully improves 
sequence etc. support - can people who know/use such things more than I have a 
look over and say whether it's suitable for inclusion?

=== Pg.pm
==================================================================
--- Pg.pm       (revision 1247)
+++ Pg.pm       (local)
@@ -20,14 +20,50 @@
    my $dbh = $self->_dbh;
    my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
      : (undef,$source->name);
-  while (my $col = shift @pri) {
-    my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_arrayref;
-    if (defined $info->[12] and $info->[12] =~
-      /^nextval\(+'([^']+)'::(?:text|regclass)\)/)
-    {
-      return $1; # may need to strip quotes -- see if this works
-    }
+
+  # First try looking for a sequence with a dependency on the
+  # given table's primary key.
+  my $sql = qq{
+    SELECT attr.attname, name.nspname, seq.relname
+    FROM pg_class      seq,
+         pg_attribute  attr,
+         pg_depend     dep,
+         pg_namespace  name,
+         pg_constraint cons
+    WHERE seq.oid           = dep.objid
+      AND seq.relnamespace  = name.oid
+      AND seq.relkind       = 'S'
+      AND attr.attrelid     = dep.refobjid
+      AND attr.attnum       = dep.refobjsubid
+      AND attr.attrelid     = cons.conrelid
+      AND attr.attnum       = cons.conkey[1]
+      AND cons.contype      = 'p'
+      AND dep.refobjid      = '$table'::regclass
+  };
+  my %hash_details;
+  @hash_details{qw(name namespace seqname)} = $dbh->selectrow_array($sql);
+
+  if( !scalar(values(%hash_details)) ){
+    # If that fails, try parsing the primary key's default value.
+    # Support the 7.x and 8.0 nextval('foo'::text) as well as
+    # the 8.1+ nextval('foo'::regclass).
+    # TODO: assumes sequence is in same schema as table.
+    my $sql2 = qq{
+        SELECT attr.attname, name.nspname, split_part(def.adsrc, '\\\'', 2)
+        FROM pg_class       t
+        JOIN pg_namespace   name ON (t.relnamespace = name.oid)
+        JOIN pg_attribute   attr ON (t.oid = attrelid)
+        JOIN pg_attrdef     def  ON (adrelid = attrelid AND adnum = attnum)
+        JOIN pg_constraint  cons ON (conrelid = adrelid AND adnum = conkey[1])
+        WHERE t.oid = '$table'::regclass
+        AND cons.contype = 'p'
+        AND def.adsrc ~* 'nextval'
+    };
+    @hash_details{qw(name namespace seqname)} = $dbh->selectrow_array($sql2); 

    }
+
+  # check for existence of . in sequence name as in public.foo_sequence.  if 
it does not exist, join the current namespace
+  return $hash_details{seqname} =~ m{\.} ? $hash_details{seqname} : 
$hash_details{namespace} .q{.}. $hash_details{seqname};
  }

  sub sqlt_type {

-- 
      Matt S Trout       Offering custom development, consultancy and support
   Technical Director    contracts for Catalyst, DBIx::Class and BAST. Contact
Shadowcat Systems Ltd.  mst (at) shadowcatsystems.co.uk for more information

+ Help us build a better perl ORM: http://dbix-class.shadowcatsystems.co.uk/ +