From: Arthur Axel 'fREW' Schmidt Date: Tue, 1 Jun 2010 04:32:59 +0000 (-0500) Subject: Add transforms for column renames etc X-Git-Tag: v0.001000_13~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f9c6ab503d63cc70fa884cadb7ed5f105f1a7bc8;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git 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 --- 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 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