From: Peter Rabbitson Date: Wed, 2 Sep 2009 12:16:01 +0000 (+0000) Subject: Make pg sequence autodetect deterministic (or throw exceptions). Test needs adjusting X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c01a6b7580315b49d0a5ab30e2693303bba9cd31;p=dbsrgits%2FDBIx-Class-Historic.git 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 --- 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 --- 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} || ''); - } "$sch_name liid 1 did not die" - or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); - 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} || ''); - } "$sch_name liid 2 did not die" - or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); - } - }, - [ (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} || ''); + } "$sch_name liid 1 did not die" + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); + + 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} || ''); + } "$sch_name liid 2 did not die" + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); } $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache