More improvements for PostgreSQL parse / diff

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");