Permalink
Browse files

Make no all changes to be deployed are already deployed.

  • Loading branch information...
1 parent 23f802d commit df6d0bcd6aa474400c568c66be04971bba60480f @theory committed Dec 22, 2012
Showing with 84 additions and 26 deletions.
  1. +2 −0 Changes
  2. +52 −25 lib/App/Sqitch/Engine.pm
  3. +9 −0 lib/App/Sqitch/Engine/pg.pm
  4. +8 −1 t/engine.t
  5. +13 −0 t/pg.t
View
@@ -17,6 +17,8 @@ Revision history for Perl extension App::Sqitch
checking depdencies for each change just before deploying or reverting
it. This allows a or revert deploy to fail sooner, with no database
changes, when dependencies are not met.
+ - Now check that no changes are already deployed before attempting to
+ deploy any changes.
0.940 2012-12-04T05:49:45Z
- Fixed tests that failed due to I18N issues, with thanks to Arnaud
@@ -247,14 +247,12 @@ sub revert {
sub check_deploy_dependencies {
my ( $self, $plan, $to_index ) = @_;
-
- my $from_index = $plan->position;
+ my $from_index = $plan->position + 1;
$to_index //= $plan->count - 1;
+ my @changes = map { $plan->change_at($_) } $from_index..$to_index;
my (%seen, @conflicts, @required);
- while ($from_index < $to_index) {
- my $change = $plan->change_at( ++$from_index );
-
+ for my $change (@changes) {
# Check for conflicts.
push @conflicts => grep {
$seen{ $_->id // '' } || $self->change_id_for_depend($_)
@@ -266,28 +264,40 @@ sub check_deploy_dependencies {
$self->change_id_for_depend($_)
)
} $change->requires;
- $seen{$change->id} = 1;
+ $seen{ $change->id } = $change;
+ }
+
+ if (@conflicts or @required) {
+ # Dependencies not satisfied. Put together the error messages.
+ my @msg;
+ push @msg, __nx(
+ 'Conflicts with previously deployed change: {changes}',
+ 'Conflicts with previously deployed changes: {changes}',
+ scalar @conflicts,
+ changes => join ' ', map { $_->as_string } @conflicts,
+ ) if @conflicts;
+
+ push @msg, __nx(
+ 'Missing required change: {changes}',
+ 'Missing required changes: {changes}',
+ scalar @required,
+ changes => join ' ', map { $_->as_string } @required,
+ ) if @required;
+
+ hurl deploy => join $/ => @msg;
}
- return $self unless @conflicts or @required;
-
- # Dependencies not satisfied. Put together the error messages.
- my @msg;
- push @msg, __nx(
- 'Conflicts with previously deployed change: {changes}',
- 'Conflicts with previously deployed changes: {changes}',
- scalar @conflicts,
- changes => join ' ', map { $_->as_string } @conflicts,
- ) if @conflicts;
-
- push @msg, __nx(
- 'Missing required change: {changes}',
- 'Missing required changes: {changes}',
- scalar @required,
- changes => join ' ', map { $_->as_string } @required,
- ) if @required;
-
- hurl deploy => join $/ => @msg;
+ # Make sure nothing isn't already deployed.
+ if ( my @ids = $self->are_deployed_changes(@changes) ) {
+ hurl deploy => __nx(
+ 'Change "{changes}" has already been deployed',
+ 'Changes have already been deployed: {changes}',
+ scalar @ids,
+ changes => join ' ', map { $seen{$_} } @ids
+ );
+ }
+
+ return $self;
}
sub check_revert_dependencies {
@@ -316,6 +326,10 @@ sub check_revert_dependencies {
}
hurl revert => join $/, @msg if @msg;
+
+ # XXX Should we make sure that they are all deployed before trying to
+ # revert them?
+
return $self;
}
@@ -608,6 +622,11 @@ sub is_deployed_change {
hurl "$class has not implemented is_deployed_change()";
}
+sub are_deployed_changes {
+ my $class = ref $_[0] || $_[0];
+ hurl "$class has not implemented are_deployed_changes()";
+}
+
sub change_id_for {
my $class = ref $_[0] || $_[0];
hurl "$class has not implemented change_id_for()";
@@ -1048,6 +1067,14 @@ the database, and false if it has not.
Should return true if the L<change|App::Sqitch::Plan::Change> has been
deployed to the database, and false if it has not.
+=head3 C<are_deployed_changes>
+
+ say "Change $_ is deployed" for $engine->are_deployed_change(@changes);
+
+Should return the IDs of any of the changes passed in that are currently
+deployed. Used by C<deploy> to ensure that no changes already deployed are
+re-deployed.
+
=head3 C<change_id_for>
say $engine->change_id_for(
@@ -562,6 +562,15 @@ sub is_deployed_change {
}, undef, $change->id)->[0];
}
+sub are_deployed_changes {
+ my $self = shift;
+ @{ $self->_dbh->selectcol_arrayref(
+ 'SELECT change_id FROM changes WHERE change_id = ANY(?)',
+ undef,
+ [ map { $_->id } @_ ],
+ ) };
+}
+
sub changes_requiring_change {
my ( $self, $change ) = @_;
return @{ $self->_dbh->selectall_arrayref(q{
View
@@ -4,7 +4,7 @@ use strict;
use warnings;
use 5.010;
use utf8;
-use Test::More tests => 352;
+use Test::More tests => 354;
#use Test::More 'no_plan';
use App::Sqitch;
use App::Sqitch::Plan;
@@ -32,6 +32,7 @@ can_ok $CLASS, qw(load new name no_prompt);
my ($is_deployed_tag, $is_deployed_change) = (0, 0);
my @deployed_changes;
+my @deployed_change_ids;
my @resolved;
my @requiring;
my @load_changes;
@@ -63,6 +64,7 @@ ENGINE: {
}
sub is_deployed_tag { push @SEEN => [ is_deployed_tag => $_[1] ]; $is_deployed_tag }
sub is_deployed_change { push @SEEN => [ is_deployed_change => $_[1] ]; $is_deployed_change }
+ sub are_deployed_changes { shift; push @SEEN => [ are_deployed_changes => [@_] ]; @deployed_change_ids }
sub change_id_for { shift; push @SEEN => [ change_id_for => {@_} ]; shift @resolved }
sub change_offset_from_id { shift; push @SEEN => [ change_offset_from_id => [@_] ]; $offset_change }
sub changes_requiring_change { push @SEEN => [ changes_requiring_change => $_[1] ]; @{ shift @requiring } }
@@ -189,6 +191,7 @@ for my $abs (qw(
log_new_tags
is_deployed_tag
is_deployed_change
+ are_deployed_changes
change_id_for
changes_requiring_change
earliest_change_id
@@ -1367,6 +1370,9 @@ CHECK_DEPLOY_DEPEND: {
$plan->reset;
ok $engine->check_deploy_dependencies($plan),
'All planned changes should be okay';
+ is_deeply $engine->seen, [
+ [ are_deployed_changes => [map { $plan->change_at($_) } 0..$plan->count - 1] ],
+ ], 'Should have called are_deployed_changes';
# Make sure it works when depending on a previous change.
my $change = $plan->change_at(3);
@@ -1414,6 +1420,7 @@ CHECK_DEPLOY_DEPEND: {
), 'Should have localized message about conflicts';
is_deeply $engine->seen, [
+ [ are_deployed_changes => [map { $plan->change_at($_) } 0..$start_from-1] ],
[ change_id_for => {
change_id => undef,
change => 'foo',
View
@@ -441,8 +441,12 @@ subtest 'live database' => sub {
my ($tag) = $change->tags;
is $change->name, 'users', 'Should have "users" change';
ok !$pg->is_deployed_change($change), 'The change should not be deployed';
+ is_deeply [$pg->are_deployed_changes($change)], [],
+ 'The change should not be deployed';
ok $pg->log_deploy_change($change), 'Deploy "users" change';
ok $pg->is_deployed_change($change), 'The change should now be deployed';
+ is_deeply [$pg->are_deployed_changes($change)], [$change->id],
+ 'The change should now be deployed';
is $pg->earliest_change_id, $change->id, 'Should get users ID for earliest change ID';
is $pg->earliest_change_id(1), undef, 'Should get no change offset 1 from earliest';
@@ -585,6 +589,8 @@ subtest 'live database' => sub {
# Test log_revert_change().
ok $pg->log_revert_change($change), 'Revert "users" change';
ok !$pg->is_deployed_change($change), 'The change should no longer be deployed';
+ is_deeply [$pg->are_deployed_changes($change)], [],
+ 'The change should no longer be deployed';
is $pg->earliest_change_id, undef, 'Should get undef for earliest change';
is $pg->latest_change_id, undef, 'Should get undef for latest change';
@@ -643,6 +649,8 @@ subtest 'live database' => sub {
# Test log_fail_change().
ok $pg->log_fail_change($change), 'Fail "users" change';
ok !$pg->is_deployed_change($change), 'The change still should not be deployed';
+ is_deeply [$pg->are_deployed_changes($change)], [],
+ 'The change still should not be deployed';
is $pg->earliest_change_id, undef, 'Should still get undef for earliest change';
is $pg->latest_change_id, undef, 'Should still get undef for latest change';
is_deeply all_changes(), [], 'Still should have not changes table record';
@@ -712,6 +720,8 @@ subtest 'live database' => sub {
is $pg->latest_change_id(1), undef, 'Should still get no change offset 1 from latest';
ok my $change2 = $plan->change_at(1), 'Get the second change';
+ is_deeply [sort $pg->are_deployed_changes($change, $change2)], [$change->id],
+ 'Only the first change should be deployed';
my ($req) = $change2->requires;
ok $req->resolved_id($change->id), 'Set resolved ID in required depend';
ok $pg->log_deploy_change($change2), 'Deploy second change';
@@ -746,6 +756,9 @@ subtest 'live database' => sub {
$change2->planner_email,
],
], 'Should have both changes and requires/conflcits deployed';
+ is_deeply [sort $pg->are_deployed_changes($change, $change2)],
+ [sort $change->id, $change2->id],
+ 'Both changes should be deployed';
is_deeply get_dependencies($change->id), [],
'Should still have no dependencies for "users"';
is_deeply get_dependencies($change2->id), [

0 comments on commit df6d0bc

Please sign in to comment.