[merge] Batch alter support for Pg and refactoring
Dagfinn Ilmari Mannsåker [Tue, 2 Sep 2014 13:57:20 +0000 (14:57 +0100)]
Fixes #44

Changes
lib/SQL/Translator/Diff.pm
lib/SQL/Translator/Producer/MySQL.pm
lib/SQL/Translator/Producer/PostgreSQL.pm
lib/SQL/Translator/Producer/SQLite.pm
lib/SQL/Translator/Utils.pm
t/30sqlt-new-diff-pgsql.t
t/postgresql-rename-table-and-field.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 9e91b66..39f808e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,7 @@ Changes for SQL::Translator
  * Fix handling of views in MySQL DBI parser
  * Fix handling of renamed fields in SQLite diff (Peter Mottram)
  * Check numeric equality of default values in numeric-type fields (Wallace Reis)
+ * Fix handling of renamed fields in renamed tables in Pg diff (Peter Mottram)
 
 0.11018 2013-10-31 🎃
 
index d8d6503..4218fc3 100644 (file)
@@ -520,6 +520,11 @@ supports the ability to do all alters for a table as one statement.
 If the diff would need a method that is missing from the producer, just emit a
 comment showing the method is missing, rather than dieing with an error
 
+=item B<producer_args>
+
+Hash of extra arguments passed to L<SQL::Translator/new> and the below
+L</PRODUCER FUNCTIONS>.
+
 =back
 
 =head1 PRODUCER FUNCTIONS
@@ -530,34 +535,35 @@ thrown.
 
 =over
 
-=item * C<alter_create_constraint($con)>
+=item * C<alter_create_constraint($con, $args)>
 
-=item * C<alter_drop_constraint($con)>
+=item * C<alter_drop_constraint($con, $args)>
 
-=item * C<alter_create_index($idx)>
+=item * C<alter_create_index($idx, $args)>
 
-=item * C<alter_drop_index($idx)>
+=item * C<alter_drop_index($idx, $args)>
 
-=item * C<add_field($fld)>
+=item * C<add_field($fld, $args)>
 
-=item * C<alter_field($old_fld, $new_fld)>
+=item * C<alter_field($old_fld, $new_fld, $args)>
 
-=item * C<rename_field($old_fld, $new_fld)>
+=item * C<rename_field($old_fld, $new_fld, $args)>
 
-=item * C<drop_field($fld)>
+=item * C<drop_field($fld, $args)>
 
-=item * C<alter_table($table)>
+=item * C<alter_table($table, $args)>
 
-=item * C<drop_table($table)>
+=item * C<drop_table($table, $args)>
 
-=item * C<rename_table($old_table, $new_table)> (optional)
+=item * C<rename_table($old_table, $new_table, $args)> (optional)
 
-=item * C<batch_alter_table($table, $hash)> (optional)
+=item * C<batch_alter_table($table, $hash, $args)> (optional)
 
 If the producer supports C<batch_alter_table>, it will be called with the
 table to alter and a hash, the keys of which will be the method names listed
 above; values will be arrays of fields or constraints to operate on. In the
-case of the field functions that take two arguments this will appear as a hash.
+case of the field functions that take two arguments this will appear as an
+array reference.
 
 I.e. the hash might look something like the following:
 
@@ -568,7 +574,7 @@ I.e. the hash might look something like the following:
  }
 
 
-=item * C<preprocess_schema($class, $schema)> (optional)
+=item * C<preprocess_schema($schema)> (optional)
 
 C<preprocess_schema> is called by the Diff code to allow the producer to
 normalize any data it needs to first. For example, the MySQL producer uses
index 6ebaf9d..3dff193 100644 (file)
@@ -93,7 +93,9 @@ my $DEFAULT_MAX_ID_LENGTH = 64;
 use Data::Dumper;
 use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(debug header_comment
-    truncate_id_uniquely parse_mysql_version);
+    truncate_id_uniquely parse_mysql_version
+    batch_alter_table_statements
+);
 
 #
 # Use only lowercase for the keys (e.g. "long" and not "LONG")
@@ -909,21 +911,7 @@ sub batch_alter_table {
 
   }
 
-  my @stmts = map {
-    if (@{ $diff_hash->{$_} || [] }) {
-      my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
-      map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
-    } else { () }
-  } qw/rename_table
-       alter_drop_constraint
-       alter_drop_index
-       drop_field
-       add_field
-       alter_field
-       rename_field
-       alter_create_index
-       alter_create_constraint
-       alter_table/;
+  my @stmts = batch_alter_table_statements($diff_hash, $options);
 
   #quote
   my $qt = $options->{quote_table_names} || '';
index 5f898ac..7fd7159 100644 (file)
@@ -27,7 +27,7 @@ $DEBUG = 0 unless defined $DEBUG;
 
 use base qw(SQL::Translator::Producer);
 use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
+use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
 use SQL::Translator::Generator::DDL::PostgreSQL;
 use Data::Dumper;
 
@@ -1019,6 +1019,47 @@ sub drop_table {
     return $out;
 }
 
+sub batch_alter_table {
+  my ( $table, $diff_hash, $options ) = @_;
+  my $qt = $options->{quote_table_names} || '';
+  $generator->quote_chars([$qt]);
+
+  # as long as we're not renaming the table we don't need to be here
+  if ( @{$diff_hash->{rename_table}} == 0 ) {
+    return batch_alter_table_statements($diff_hash, $options);
+  }
+
+  # first we need to perform drops which are on old table
+  my @sql = batch_alter_table_statements($diff_hash, $options, qw(
+    alter_drop_constraint
+    alter_drop_index
+    drop_field
+  ));
+
+  # next comes the rename_table
+  my $old_table = $diff_hash->{rename_table}[0][0];
+  push @sql, rename_table( $old_table, $table, $options );
+
+  # for alter_field (and so also rename_field) we need to make sure old
+  # field has table name set to new table otherwise calling alter_field dies
+  $diff_hash->{alter_field} =
+    [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
+  $diff_hash->{rename_field} =
+    [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
+
+  # now add everything else
+  push @sql, batch_alter_table_statements($diff_hash, $options, qw(
+    add_field
+    alter_field
+    rename_field
+    alter_create_index
+    alter_create_constraint
+    alter_table
+  ));
+
+  return @sql;
+}
+
 1;
 
 # -------------------------------------------------------------------
index ec35038..aefd038 100644 (file)
@@ -21,7 +21,7 @@ use strict;
 use warnings;
 use Data::Dumper;
 use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
+use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
 use SQL::Translator::Generator::DDL::SQLite;
 
 our ( $DEBUG, $WARN );
@@ -406,7 +406,7 @@ sub alter_drop_index {
 }
 
 sub batch_alter_table {
-  my ($table, $diffs) = @_;
+  my ($table, $diffs, $options) = @_;
 
   # If we have any of the following
   #
@@ -439,21 +439,7 @@ sub batch_alter_table {
        @{$diffs->{alter_field}}  == 0 &&
        @{$diffs->{drop_field}}   == 0
        ) {
-    return map {
-        my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
-        map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ?  ("$sql") : () } @{ $diffs->{$_} }
-
-      } grep { @{$diffs->{$_}} }
-    qw/rename_table
-       alter_drop_constraint
-       alter_drop_index
-       drop_field
-       add_field
-       alter_field
-       rename_field
-       alter_create_index
-       alter_create_constraint
-       alter_table/;
+    return batch_alter_table_statements($diffs, $options);
   }
 
   my @sql;
index ffcf6f3..b297ab7 100644 (file)
@@ -15,7 +15,7 @@ use base qw(Exporter);
 our @EXPORT_OK = qw(
     debug normalize_name header_comment parse_list_arg truncate_id_uniquely
     $DEFAULT_COMMENT parse_mysql_version parse_dbms_version
-    ddl_parser_instance
+    ddl_parser_instance batch_alter_table_statements
     throw ex2err carp_ro
 );
 use constant COLLISION_TAG_LENGTH => 8;
@@ -220,7 +220,8 @@ sub ddl_parser_instance {
     });
 
 # this is disabled until RT#74593 is resolved
-=begin for general sadness
+
+=begin sadness
 
     unless ($parsers_libdir) {
 
@@ -280,6 +281,9 @@ sub ddl_parser_instance {
     }
 
     return $precompiled_mod->new;
+
+=end sadness
+
 =cut
 
 }
@@ -344,6 +348,31 @@ sub carp_ro {
     };
 }
 
+sub batch_alter_table_statements {
+    my ($diff_hash, $options, @meths) = @_;
+
+    @meths = qw(
+        rename_table
+        alter_drop_constraint
+        alter_drop_index
+        drop_field
+        add_field
+        alter_field
+        rename_field
+        alter_create_index
+        alter_create_constraint
+        alter_table
+    ) unless @meths;
+
+    my $package = caller;
+
+    return map {
+        my $meth = $package->can($_) or die "$package cant $_";
+        map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_, $options) } @{ $diff_hash->{$_} }
+    } grep { @{$diff_hash->{$_} || []} }
+        @meths;
+}
+
 1;
 
 =pod
@@ -519,6 +548,43 @@ Takes a field name and returns a reference to a function can be used
 L<around|Moo/around> a read-only accessor to make it L<carp|Carp/carp>
 instead of die when passed an argument.
 
+=head2 batch_alter_table_statements
+
+Takes diff and argument hashes as passed to
+L<batch_alter_table|SQL::Translator::Diff/batch_alter_table($table, $hash) (optional)>
+and an optional list of producer functions to call on the calling package.
+Returns the list of statements returned by the producer functions.
+
+If no producer functions are specified, the following functions in the
+calling package are called:
+
+=over
+
+=item 1. rename_table
+
+=item 2. alter_drop_constraint
+
+=item 3. alter_drop_index
+
+=item 4. drop_field
+
+=item 5. add_field
+
+=item 5. alter_field
+
+=item 6. rename_field
+
+=item 7. alter_create_index
+
+=item 8. alter_create_constraint
+
+=item 9. alter_table
+
+=back
+
+If the corresponding array in the hash has any elements, but the
+caller doesn't implement that function, an exception is thrown.
+
 =head1 AUTHORS
 
 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
index ba61ee5..716af4b 100644 (file)
@@ -55,18 +55,21 @@ CREATE TABLE added (
   id bigint
 );
 
-ALTER TABLE old_name RENAME TO new_name;
-
 ALTER TABLE employee DROP CONSTRAINT FK5302D47D93FE702E;
 
-ALTER TABLE person DROP CONSTRAINT UC_age_name;
+ALTER TABLE employee DROP COLUMN job_title;
 
-DROP INDEX u_name;
+ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id)
+  REFERENCES person (person_id) DEFERRABLE;
 
-ALTER TABLE employee DROP COLUMN job_title;
+ALTER TABLE old_name RENAME TO new_name;
 
 ALTER TABLE new_name ADD COLUMN new_field integer;
 
+ALTER TABLE person DROP CONSTRAINT UC_age_name;
+
+DROP INDEX u_name;
+
 ALTER TABLE person ADD COLUMN is_rock_star smallint DEFAULT 1;
 
 ALTER TABLE person ALTER COLUMN person_id TYPE serial;
@@ -85,9 +88,6 @@ ALTER TABLE person RENAME COLUMN description TO physical_description;
 
 ALTER TABLE person ADD CONSTRAINT unique_name UNIQUE (name);
 
-ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id)
-  REFERENCES person (person_id) DEFERRABLE;
-
 ALTER TABLE person ADD CONSTRAINT UC_person_id UNIQUE (person_id);
 
 ALTER TABLE person ADD CONSTRAINT UC_age_name UNIQUE (age, name);
@@ -118,14 +118,14 @@ CREATE TABLE added (
   id bigint
 );
 
-ALTER TABLE old_name RENAME TO new_name;
-
-ALTER TABLE person DROP CONSTRAINT UC_age_name;
-
 ALTER TABLE employee DROP COLUMN job_title;
 
+ALTER TABLE old_name RENAME TO new_name;
+
 ALTER TABLE new_name ADD COLUMN new_field integer;
 
+ALTER TABLE person DROP CONSTRAINT UC_age_name;
+
 ALTER TABLE person ADD COLUMN is_rock_star smallint DEFAULT 1;
 
 ALTER TABLE person ALTER COLUMN person_id TYPE serial;
diff --git a/t/postgresql-rename-table-and-field.t b/t/postgresql-rename-table-and-field.t
new file mode 100644 (file)
index 0000000..887f023
--- /dev/null
@@ -0,0 +1,91 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use Test::SQL::Translator;
+use SQL::Translator;
+use SQL::Translator::Diff;
+
+maybe_plan(undef, 'DBD::Pg');
+
+my ( $pgsql, $ddl, $ret, $dsn, $user, $pass );
+if ($ENV{DBICTEST_PG_DSN}) {
+    ($dsn, $user, $pass) = map { $ENV{"DBICTEST_PG_$_"} } qw(DSN USER PASS);
+}
+else {
+    no warnings 'once';
+    maybe_plan(undef, 'Test::PostgreSQL');
+    $pgsql = Test::PostgreSQL->new
+        or die "Can't create test database: $Test::PostgreSQL::errstr";
+    $dsn = $pgsql->dsn;
+};
+
+my $dbh = DBI->connect($dsn, $user, $pass, { RaiseError => 1, AutoCommit => 1 });
+$dbh->do('SET client_min_messages=warning');
+
+my $source_ddl = <<DDL;
+CREATE TABLE sqlt_test_foo (
+    pk  SERIAL PRIMARY KEY,
+    bar VARCHAR(10)
+);
+DDL
+
+ok( $ret = $dbh->do($source_ddl), "create table" );
+
+ok( $ret = $dbh->do(q| INSERT INTO sqlt_test_foo (bar) VALUES ('buzz') |), "insert data" );
+
+cmp_ok( $ret, '==', 1, "one row inserted" );
+
+my $target_ddl = <<DDL;
+CREATE TABLE sqlt_test_fluff (
+    pk   SERIAL PRIMARY KEY,
+    biff VARCHAR(10)
+);
+DDL
+
+my $source_sqlt = SQL::Translator->new(
+    no_comments => 1,
+    parser   => 'SQL::Translator::Parser::PostgreSQL',
+)->translate(\$source_ddl);
+
+my $target_sqlt = SQL::Translator->new(
+    no_comments => 1,
+    parser   => 'SQL::Translator::Parser::PostgreSQL',
+)->translate(\$target_ddl);
+
+my $table = $target_sqlt->get_table('sqlt_test_fluff');
+$table->extra( renamed_from => 'sqlt_test_foo' );
+my $field = $table->get_field('biff');
+$field->extra( renamed_from => 'bar' );
+
+my @diff = SQL::Translator::Diff->new({
+    output_db => 'PostgreSQL',
+    source_schema => $source_sqlt,
+    target_schema => $target_sqlt,
+})->compute_differences->produce_diff_sql;
+
+foreach my $line (@diff) {
+    $line =~ s/\n//g;
+    next if $line =~ /^--/;
+    lives_ok { $dbh->do($line) } "$line";
+}
+
+ok ( $ret = $dbh->selectall_arrayref(q(SELECT biff FROM sqlt_test_fluff), { Slice => {} }), "query DB for data" );
+
+cmp_ok( scalar(@$ret), '==', 1, "Got 1 row");
+
+cmp_ok( $ret->[0]->{biff}, 'eq', 'buzz', "col biff has value buzz" );
+
+# Make sure Test::PostgreSQL can kill Pg
+undef $dbh if $pgsql;
+
+END {
+    if ($dbh && !$pgsql) {
+        $dbh->do("drop table if exists sqlt_test_$_") foreach qw(foo fluff);
+    }
+}
+
+done_testing;