More improvements for PostgreSQL parse / diff (#161)

* Fix ::Parser::DBI::PostgreSQL bug that swapped on_update and on_delete

The parser was storing the ON UPDATE value into the constraint's
on_delete attribute, and vice versa.  This caused foreign keys to
always show as diffs in SQL::Translator::Diff if the on_update
differed from on_delete.

* Add option to run t/66-postgres-dbi-parser.t with Test::PostgreSQL

Test::PostgreSQL requires the postgres server binaries to be installed
on the host, which is a steep requirement.  So, eval{} both the
presence of the module and whether the module is successfully able to
create a postgres instance.  If so, use that.  (but only if none of
the env variables were set)

* New ::Parser::DBI::PostgreSQL option deconstruct_enum_types

The ::Producer::PostgreSQL will take a column definition of
data_type 'enum' and convert it to a postgres custom data type,
and then declare the column of that type.  When parsed, the column
no longer shows the values of the enum and the data_type is the
custom name rather than 'enum'.  This new option reaches into the
postgres type to find the enum values, and reverts the data_type
to 'enum', like it was originally.

* Handle addition of enum values in ::Producer::PostgreSQL->alter_field

Now, when producing a diff between two enum columns where the list
of values are known, and when the postgres version is greater than
9.001, the producer will generate an ALTER TYPE ... ADD VALUE
statments if the new enum includes values that the old one did not.
This is an easy case to support because it does not involve
re-creating the type.

The harder case of removing an enum value is not supported, yet.
The output includes a SQL comment to that effect, giving the
user a note that they need to perform that step on their own.

lib/SQL/Translator/Parser/DBI/PostgreSQL.pm

@@ -12,6 +12,33 @@ See SQL::Translator::Parser::DBI.
 
 Uses DBI to query PostgreSQL system tables to determine schema structure.
 
+=head1 CONFIGURATION
+
+You can specify the following for L<SQL::Translator/parser_args> :
+
+=head2 deconstruct_enum_types
+
+If set to a true value, the parser will look for column types which are user-defined Enums,
+and generate a column definition like:
+
+  {
+    data_type => 'enum',
+    extra => {
+      custom_type_name => 'MyEnumType',
+      list => [ 'enum_val_1', 'enum_val_2', ... ],
+    }
+  }
+
+This makes a proper round-trip with SQL::Translator::Producer::PostgreSQL (which re-creates the
+custom enum type if C<< producer_args->{postgres_version} >= 8.003 >>) and can be translated to
+other engines.
+
+If the option is false (the default) you would just get
+
+  { data_type => 'MyEnumType' }
+
+with no provided method to translate it to other SQL engines.
+
 =cut
 
 use strict;
@@ -35,9 +62,10 @@ sub parse {
     my ( $tr, $dbh ) = @_;
 
     my $schema = $tr->schema;
+    my $deconstruct_enum_types = $tr->parser_args->{deconstruct_enum_types};
 
     my $column_select = $dbh->prepare(
-      "SELECT a.attname, format_type(t.oid, a.atttypmod) as typname, a.attnum,
+      "SELECT a.attname, a.atttypid, t.typtype, format_type(t.oid, a.atttypmod) as typname, a.attnum,
               a.atttypmod as length, a.attnotnull, a.atthasdef, pg_get_expr(ad.adbin, ad.adrelid) as adsrc,
               d.description
        FROM pg_type t, pg_attribute a
@@ -104,6 +132,17 @@ WHERE pg_catalog.pg_table_is_visible(c.oid)
 ORDER BY 1;
         /) or die "Can't prepare: $@";
 
+    my %enum_types;
+    if ($deconstruct_enum_types) {
+        my $enum_select = $dbh->prepare(
+            'SELECT enumtypid, enumlabel FROM pg_enum ORDER BY oid, enumsortorder'
+            ) or die "Can't prepare: $@";
+        $enum_select->execute();
+        while ( my $enumval = $enum_select->fetchrow_hashref ) {
+            push @{$enum_types{ $enumval->{enumtypid} }}, $enumval->{enumlabel};
+        }
+    }
+
     $table_select->execute();
 
     while ( my $tablehash = $table_select->fetchrow_hashref ) {
@@ -146,6 +185,11 @@ ORDER BY 1;
                 }
                 else { $col->default_value(\$default) }
             }
+            if ($deconstruct_enum_types && $enum_types{$columnhash->{atttypid}}) {
+                $col->extra->{custom_type_name} = $col->data_type;
+                $col->extra->{list} = [ @{ $enum_types{$columnhash->{atttypid}} } ];
+                $col->data_type('enum');
+            }
             $col->is_nullable( $$columnhash{'attnotnull'} ? 0 : 1 );
             $col->comments($$columnhash{'description'}) if $$columnhash{'description'};
             $column_by_attrid{$$columnhash{'attnum'}}= $$columnhash{'attname'};
@@ -199,8 +243,8 @@ ORDER BY 1;
                                    fields =>  $fields,
                                    reference_fields => $reference_fields,
                                    reference_table => $reference_table,
-                                   on_delete  => $actions->{$on_upd},
-                                   on_update  => $actions->{$on_del},
+                                   on_update  => $actions->{$on_upd},
+                                   on_delete  => $actions->{$on_del},
                                );
         }
     }

lib/SQL/Translator/Producer/PostgreSQL.pm

@@ -493,6 +493,20 @@ sub create_view {
     return $create;
 }
 
+# Returns a enum custom type name and list of values iff the field looks like an enum.
+sub _enum_typename_and_values {
+    my $field = shift;
+    if (ref $field->extra->{list} eq 'ARRAY') { # can't do anything unless we know the list
+        if ($field->extra->{custom_type_name}) {
+            return ( $field->extra->{custom_type_name}, $field->extra->{list} );
+        } elsif ($field->data_type eq 'enum') {
+            my $name= $field->table->name . '_' . $field->name . '_type';
+            return ( $name, $field->extra->{list} );
+        }
+    }
+    return ();
+}
+
 {
 
     my %field_name_scope;
@@ -524,18 +538,17 @@ sub create_view {
         #
         my $data_type = lc $field->data_type;
         my %extra     = $field->extra;
-        my $list      = $extra{'list'} || [];
-        my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
-
-        if ($postgres_version >= 8.003 && $data_type eq 'enum') {
-            my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
-            $field_def .= ' '. $type_name;
-            my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
-                               "CREATE TYPE $type_name AS ENUM ($commalist)";
-            if (! exists $type_defs->{$type_name} ) {
-                $type_defs->{$type_name} = $new_type_def;
-            } elsif ( $type_defs->{$type_name} ne $new_type_def ) {
-                die "Attempted to redefine type name '$type_name' as a different type.\n";
+        my ($enum_typename, $list) = _enum_typename_and_values($field);
+
+        if ($postgres_version >= 8.003 && $enum_typename) {
+            my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
+            $field_def .= ' '. $enum_typename;
+            my $new_type_def = "DROP TYPE IF EXISTS $enum_typename CASCADE;\n" .
+                               "CREATE TYPE $enum_typename AS ENUM ($commalist)";
+            if (! exists $type_defs->{$enum_typename} ) {
+                $type_defs->{$enum_typename} = $new_type_def;
+            } elsif ( $type_defs->{$enum_typename} ne $new_type_def ) {
+                die "Attempted to redefine type name '$enum_typename' as a different type.\n";
             }
         } else {
             $field_def .= ' '. convert_datatype($field);
@@ -896,6 +909,25 @@ sub alter_field
                    )
         if($to_dt ne $from_dt);
 
+    my ($from_enum_typename, $from_list) = _enum_typename_and_values($from_field);
+    my ($to_enum_typename,   $to_list  ) = _enum_typename_and_values($to_field);
+    if ($from_enum_typename && $to_enum_typename && $from_enum_typename eq $to_enum_typename) {
+        # See if new enum values were added, and update the enum
+        my %existing_vals = map +($_ => 1), @$from_list;
+        my %desired_vals = map +($_ => 1), @$to_list;
+        my @add_vals = grep !$existing_vals{$_}, keys %desired_vals;
+        my @del_vals = grep !$desired_vals{$_}, keys %existing_vals;
+        my $pg_ver_ok= ($options->{postgres_version} || 0) >= 9.001;
+        push @out, '-- Set $sqlt->producer_args->{postgres_version} >= 9.001 to alter enums'
+            if !$pg_ver_ok && @add_vals;
+        for (@add_vals) {
+            push @out, sprintf '%sALTER TYPE %s ADD VALUE IF NOT EXISTS %s',
+                ($pg_ver_ok? '':'-- '), $to_enum_typename, $generator->quote_string($_);
+        }
+        push @out, "-- Unimplemented: delete values from enum type '$to_enum_typename': ".join(", ", @del_vals)
+            if @del_vals;
+    }
+
     my $old_default = $from_field->default_value;
     my $new_default = $to_field->default_value;
     my $default_value = $to_field->default_value;

t/47postgres-producer.t

@@ -391,6 +391,34 @@ is_deeply(
     'Create real enum type works'
 );
 
+my $field5a = SQL::Translator::Schema::Field->new( name => 'enum_field',
+                                                   table => $table,
+                                                   data_type => 'enum',
+                                                   extra => {
+                                                      custom_type_name => 'mytable_enum_field_type',
+                                                      list => [ 'Foo', 'Bar', 'Ba\'z' ]
+                                                   },
+                                                   is_auto_increment => 0,
+                                                   is_nullable => 0,
+                                                   is_foreign_key => 0,
+                                                   is_unique => 0 );
+my $field5b = SQL::Translator::Schema::Field->new( name => 'enum_field',
+                                                   table => $table,
+                                                   data_type => 'enum',
+                                                   extra => {
+                                                      custom_type_name => 'mytable_enum_field_type',
+                                                      list => [ 'Foo', 'Bar', 'Ba\'z', 'Other' ]
+                                                   },
+                                                   is_auto_increment => 0,
+                                                   is_nullable => 0,
+                                                   is_foreign_key => 0,
+                                                   is_unique => 0 );
+
+$alter_field= SQL::Translator::Producer::PostgreSQL::alter_field($field5a,
+                                                                 $field5b,
+                                                                 { postgres_version => 9.001 });
+is( $alter_field, q(ALTER TYPE mytable_enum_field_type ADD VALUE IF NOT EXISTS 'Other'), 'Add value to enum' );
+
 my $field6 = SQL::Translator::Schema::Field->new(
                                                   name      => 'character',
                                                   table => $table,

t/66-postgres-dbi-parser.t

@@ -9,10 +9,12 @@ use Test::SQL::Translator qw(maybe_plan table_ok);
 
 maybe_plan(undef, 'SQL::Translator::Parser::DBI::PostgreSQL');
 
+my $pgsql;
 my @dsn =
   $ENV{DBICTEST_PG_DSN} ? @ENV{ map { "DBICTEST_PG_$_" } qw/DSN USER PASS/ }
 : $ENV{DBI_DSN} ? @ENV{ map { "DBI_$_" } qw/DSN USER PASS/ }
-: plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test';
+: eval { require Test::PostgreSQL and ($pgsql= Test::PostgreSQL->new()) }? ( $pgsql->dsn, '', '' )
+: plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test, or install Test::PostgreSQL';
 
 my $dbh = eval {
   DBI->connect(@dsn, {AutoCommit => 1, RaiseError=>1,PrintError => 1} );
@@ -23,26 +25,33 @@ if (my $err = ($@ || $DBI::err )) {
     plan skip_all => "No connection to test db. DBI says '$err'";
 }
 
+# Cleanly shut down Test::PostgreSQL if it is being used
+END { undef $dbh; undef $pgsql; }
+
 ok($dbh, "dbh setup correctly");
 $dbh->do('SET client_min_messages=WARNING');
 
 my $sql = q[
     drop table if exists sqlt_test2;
     drop table if exists sqlt_test1;
     drop table if exists sqlt_products_1;
+    drop type if exists example_enum;
+
+    create type example_enum as enum('alpha','beta');
 
     create table sqlt_test1 (
         f_serial serial NOT NULL primary key,
         f_varchar character varying(255),
         f_text text default 'FOO',
         f_to_drop integer,
-        f_last text
+        f_text2 text,
+        f_enum example_enum default 'alpha'
     );
 
     comment on table sqlt_test1 is 'this is a comment on the first table';
     comment on column sqlt_test1.f_text is 'this is a comment on a field of the first table';
 
-    create index sqlt_test1_f_last_idx on sqlt_test1 (f_last);
+    create index sqlt_test1_f_text2_idx on sqlt_test1 (f_text2);
 
     create table sqlt_test2 (
         f_id integer NOT NULL,
@@ -59,7 +68,7 @@ my $sql = q[
     );
 
     -- drop a column, to not have a linear id
-    -- When the table t_test1 is created, f_last get id 5 but
+    -- When the table t_test1 is created, f_text2 get id 5 but
     -- after this drop, there is only 4 columns.
     alter table sqlt_test1 drop column f_to_drop;
 ];
@@ -72,7 +81,7 @@ $dbh->do($sql);
 my $t = SQL::Translator->new(
   trace => 0,
   parser => 'DBI',
-  parser_args => { dbh => $dbh },
+  parser_args => { dbh => $dbh, deconstruct_enum_types => 1 },
 );
 $t->translate;
 my $schema = $t->schema;
@@ -88,7 +97,7 @@ is( $t1->name, 'sqlt_test1', 'Table sqlt_test1 exists' );
 is( $t1->comments, 'this is a comment on the first table', 'First table has a comment');
 
 my @t1_fields = $t1->get_fields;
-is( scalar @t1_fields, 4, '4 fields in sqlt_test1' );
+is( scalar @t1_fields, 5, '5 fields in sqlt_test1' );
 
 my $f1 = shift @t1_fields;
 is( $f1->name, 'f_serial', 'First field is "f_serial"' );
@@ -120,14 +129,20 @@ is( $f3->is_auto_increment, 0, 'Field is not auto increment' );
 is( $f3->comments, 'this is a comment on a field of the first table', 'There is a comment on the third field');
 
 my $f4 = shift @t1_fields;
-is( $f4->name, 'f_last', 'Fouth field is "f_last"' );
+is( $f4->name, 'f_text2', 'Fouth field is "f_text2"' );
 is( $f4->data_type, 'text', 'Field is a text' );
 is( $f4->is_nullable, 1, 'Field can be null' );
 is( $f4->size, 0, 'Size is 0' );
 is( $f4->default_value, undef, 'No default value' );
 is( $f4->is_primary_key, 0, 'Field is not PK' );
 is( $f4->is_auto_increment, 0, 'Field is not auto increment' );
 
+my $f5 = shift @t1_fields;
+is( $f5->name, 'f_enum', 'Fifth field is "f_enum"' );
+is( $f5->data_type, 'enum', 'Field is a decomposed enum' );
+is( $f5->default_value, 'alpha', 'Default value "alpha"' );
+is_deeply( { $f5->extra }, { custom_type_name => 'example_enum', list => [ 'alpha', 'beta' ] }, 'Field "extra" enum description' );
+
 #TODO: no 'NOT NULL' constraint not set
 
 my $t2 = $schema->get_table("sqlt_test2");