Add transforms for column renames etc

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index 533924e..3dc9d9b 100644 (file)
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -134,8 +134,36 @@ method _ddl_schema_consume_filenames($type, $version) {
   $self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
 }
 
+method _ddl_protoschema_up_consume_filenames($versions) {
+  my $base_dir = $self->script_directory;
+
+  my $dir = catfile( $base_dir, '_protoschema', 'up', join q(-), @{$versions});
+
+  return [] unless -d $dir;
+
+  opendir my($dh), $dir;
+  my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+  closedir $dh;
+
+  return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_down_consume_filenames($versions) {
+  my $base_dir = $self->script_directory;
+
+  my $dir = catfile( $base_dir, '_protoschema', 'down', join q(-), @{$versions});
+
+  return [] unless -d $dir;
+
+  opendir my($dh), $dir;
+  my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+  closedir $dh;
+
+  return [@files{sort keys %files}]
+}
+
 method _ddl_protoschema_produce_filename($version) {
-  my $dirname = catfile( $self->script_directory, '_protoschema', $version );
+  my $dirname = catfile( $self->script_directory, '_protoschema', 'schema',  $version );
   mkpath($dirname) unless -d $dirname;
 
   return catfile( $dirname, '001-auto.yml' );
@@ -297,7 +325,7 @@ sub preinstall {
   }
 }
 
-method _sqldiff_from_yaml($from_version, $to_version, $db) {
+method _sqldiff_from_yaml($from_version, $to_version, $db, $direction) {
   my $dir       = $self->script_directory;
   my $sqltargs = {
     add_drop_table => 1,
@@ -353,6 +381,13 @@ method _sqldiff_from_yaml($from_version, $to_version, $db) {
     $dest_schema->name( $filename )
       unless $dest_schema->name;
   }
+
+  my $transform_files_method =  "_ddl_protoschema_${direction}_consume_filenames";
+  my $transforms = $self->_coderefs_per_files(
+    $self->$transform_files_method([$from_version, $to_version])
+  );
+  $_->($source_schema, $dest_schema) for @$transforms;
+
   return [SQL::Translator::Diff::schema_diff(
      $source_schema, $db,
      $dest_schema,   $db,
@@ -483,6 +518,11 @@ sub prepare_downgrade {
   );
 }
 
+method _coderefs_per_files($files) {
+  no warnings 'redefine';
+  [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
+}
+
 method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
   my $schema    = $self->schema;
   my $databases = $self->databases;
@@ -498,7 +538,7 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
     }
 
     open my $file, q(>), $diff_file;
-    print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db)};
+    print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
     close $file;
   }
 }
@@ -530,7 +570,7 @@ sub downgrade_single_step {
   my $sql_to_run;
   if ($self->ignore_ddl) {
      $sql_to_run = $self->_sqldiff_from_yaml(
-       $version_set->[0], $version_set->[1], $sqlt_type
+       $version_set->[0], $version_set->[1], $sqlt_type, 'down',
      );
   }
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
@@ -550,7 +590,7 @@ sub upgrade_single_step {
   my $sql_to_run;
   if ($self->ignore_ddl) {
      $sql_to_run = $self->_sqldiff_from_yaml(
-       $version_set->[0], $version_set->[1], $sqlt_type
+       $version_set->[0], $version_set->[1], $sqlt_type, 'up',
      );
   }
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(

diff --git a/t/deploy_methods/sql_translator_protoschema_transform.t b/t/deploy_methods/sql_translator_protoschema_transform.t
new file mode 100644 (file)
index 0000000..d697b3c
--- /dev/null
+++ b/t/deploy_methods/sql_translator_protoschema_transform.t
@@ -0,0 +1,65 @@
+#!perl
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+use DBICDHTest;
+use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
+use File::Spec::Functions;
+use File::Path qw(rmtree mkpath);
+
+my $db = 'dbi:SQLite:db.db';
+my @connection = ($db, '', '', { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+DBICDHTest::ready;
+
+VERSION1: {
+   use_ok 'DBICVersion_v1';
+   my $s = DBICVersion::Schema->connect(@connection);
+   my $dm = Translator->new({
+      schema            => $s,
+      script_directory => $sql_dir,
+      databases         => ['SQLite'],
+      sql_translator_args          => { add_drop_table => 0 },
+   });
+
+   $dm->prepare_deploy;
+   $dm->deploy;
+}
+
+VERSION2: {
+   use_ok 'DBICVersion_v2';
+   my $s = DBICVersion::Schema->connect(@connection);
+   my $dm = Translator->new({
+      schema            => $s,
+      script_directory => $sql_dir,
+      databases         => ['SQLite'],
+      sql_translator_args          => { add_drop_table => 0 },
+      txn_wrap          => 1,
+   });
+
+   $version = $s->schema_version();
+   $dm->prepare_deploy;
+   mkpath(catfile(qw( t sql _protoschema up 1.0-2.0 )));
+   open my $prerun, '>',
+      catfile(qw( t sql _protoschema up 1.0-2.0 003-semiautomatic.pl ));
+   print {$prerun}
+      'sub {
+         use File::Touch;
+         touch(q(robotparty))
+            if $_[0]->isa("SQL::Translator::Schema")
+            && $_[1]->isa("SQL::Translator::Schema");
+      }';
+   close $prerun;
+   $dm->prepare_upgrade({
+     from_version => '1.0',
+     to_version => '2.0',
+     version_set => [qw(1.0 2.0)]
+   });
+   ok -e 'robotparty', 'intermediate script ran with the right args';
+   $dm->upgrade_single_step({ version_set => [qw( 1.0 2.0 )] });
+}
+done_testing;
+#vim: ts=2 sw=2 expandtab