view release on metacpan or  search on metacpan

lib/App/Sqitch/Engine.pm  view on Meta::CPAN

                $last_tagged = $change;
            }
        }
    } catch {
        if (my $ident = eval { $_->ident }) {
            $self->sqitch->vent($_->message) unless $ident eq 'private'
        } else {
            $self->sqitch->vent($_);
        }
        $self->_rollback($last_tagged, @run);
    };

    return $self;
}

sub _deploy_all {
    my ( $self, $plan, $to_index ) = @_;

    my @run;
    try {
        while ($plan->position < $to_index) {
            my $change = $plan->next;
            $self->deploy_change($change);
            push @run => $change;
        }
    } catch {
        if (my $ident = try { $_->ident }) {
            $self->sqitch->vent($_->message) unless $ident eq 'private'
        } else {
            $self->sqitch->vent($_);
        }
        $self->_rollback(undef, @run);
    };

    return $self;
}

sub _sync_plan {
    my $self = shift;
    my $plan = $self->plan;

    if ($self->_no_registry) {
        # No registry found on connection, so no records in the database.
        $plan->reset;
    } elsif (my $state = $self->current_state) {
        my $idx = $plan->index_of($state->{change_id}) // hurl plan => __x(
            'Cannot find change {id} ({change}) in {file}',
            id     => $state->{change_id},
            change => join(' ', $state->{change}, @{ $state->{tags} || [] }),
            file   => $plan->file,
        );

        # Upgrade the registry if there is no script_hash column.
        unless ( exists $state->{script_hash} ) {
            $self->upgrade_registry;
            $state->{script_hash} = $state->{change_id};
        }

        # Update the script hashes if they're the same as the change ID.
        # DEPRECATTION: Added in v0.998 (Jan 2015, c86cba61c); consider removing
        # in the future when all databases are likely to be updated already.
        $self->_update_script_hashes if $state->{script_hash}
            && $state->{script_hash} eq $state->{change_id};

        $plan->position($idx);
        my $change = $plan->change_at($idx);
        if (my @tags = $change->tags) {
            $self->log_new_tags($change);
            $self->start_at( $change->format_name . $tags[-1]->format_name );
        } else {
            $self->start_at( $change->format_name );
        }

    } else {
        $plan->reset;
    }
    return $plan;
}

sub is_deployed {
    my ($self, $thing) = @_;
    return $thing->isa('App::Sqitch::Plan::Tag')
        ? $self->is_deployed_tag($thing)
        : $self->is_deployed_change($thing);
}

sub deploy_change {
    my ( $self, $change ) = @_;
    my $sqitch = $self->sqitch;
    my $name = $change->format_name_with_tags;
    $sqitch->info_literal(
        "  + $name ..",
        '.' x ($self->max_name_length - length $name), ' '
    );
    $self->begin_work($change);

    return try {
        my $file = $change->deploy_file;
        hurl deploy => __x(
            'Deploy script {file} does not exist',
            file => $file,
        ) unless -e $file;
        $self->run_deploy($file) unless $self->log_only;
        try {
            $self->verify_change( $change ) if $self->with_verify;
            $self->log_deploy_change($change);
            $sqitch->info(__ 'ok');
        } catch {
            # Oy, logging or verify failed. Rollback.
            $sqitch->vent(eval { $_->message } // $_);
            $self->rollback_work($change);

            # Begin work and run the revert.
            try {
                # Don't bother displaying the reverting change name.
                # $self->sqitch->info('  - ', $change->format_name_with_tags);
                $self->begin_work($change);
                $self->run_revert($change->revert_file) unless $self->log_only;
            } catch {
                # Oy, the revert failed. Just emit the error.
                $sqitch->vent(eval { $_->message } // $_);