Factor out calling of normal diff-production functions

diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm
index 6ebaf9d..3dff193 100644 (file)
--- a/lib/SQL/Translator/Producer/MySQL.pm
+++ b/lib/SQL/Translator/Producer/MySQL.pm
@@ -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} || '';

diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm
index 1843883..7fd7159 100644 (file)
--- a/lib/SQL/Translator/Producer/PostgreSQL.pm
+++ b/lib/SQL/Translator/Producer/PostgreSQL.pm
@@ -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;
 
@@ -1026,35 +1026,15 @@ sub batch_alter_table {
 
   # as long as we're not renaming the table we don't need to be here
   if ( @{$diff_hash->{rename_table}} == 0 ) {
-    return map {
-      if (@{ $diff_hash->{$_} || [] }) {
-        my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
-        map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) }
-          @{ $diff_hash->{$_} }
-      }
-      else { () }
-    } qw/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($diff_hash, $options);
   }
 
   # first we need to perform drops which are on old table
-  my @sql = map {
-    if (@{ $diff_hash->{$_} || [] }) {
-      my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
-      map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) }
-        @{ $diff_hash->{$_} }
-    }
-    else { () }
-  } qw/alter_drop_constraint
+  my @sql = batch_alter_table_statements($diff_hash, $options, qw(
+    alter_drop_constraint
     alter_drop_index
-    drop_field/;
+    drop_field
+  ));
 
   # next comes the rename_table
   my $old_table = $diff_hash->{rename_table}[0][0];
@@ -1068,19 +1048,14 @@ sub batch_alter_table {
     [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
 
   # now add everything else
-  push @sql, map {
-    if (@{ $diff_hash->{$_} || [] }) {
-      my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
-      map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) }
-        @{ $diff_hash->{$_} }
-    }
-    else { () }
-  } qw/add_field
+  push @sql, batch_alter_table_statements($diff_hash, $options, qw(
+    add_field
     alter_field
     rename_field
     alter_create_index
     alter_create_constraint
-    alter_table/;
+    alter_table
+  ));
 
   return @sql;
 }

diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm
index ec35038..aefd038 100644 (file)
--- a/lib/SQL/Translator/Producer/SQLite.pm
+++ b/lib/SQL/Translator/Producer/SQLite.pm
@@ -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;

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index c27dc52..b297ab7 100644 (file)
--- a/lib/SQL/Translator/Utils.pm
+++ b/lib/SQL/Translator/Utils.pm
@@ -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;
@@ -348,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
@@ -523,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>,