view release on metacpan or  search on metacpan

lib/App/migrate.pm  view on Meta::CPAN

                    type            => 'BACKUP',    # internal step type
                    version         => $prev,
                    prev_version    => $prev,
                    next_version    => $next,
                });
            }
            $just_restored = 0;
            $from = $prev;
            for my $step ($self->get_steps([$prev, $next])) {
                $self->_do($step);
                if ($step->{type} eq 'RESTORE') {
                    $just_restored = 1;
                }
            }
        }
        1;
    }
    or do {
        my $err = $@;
        if ($from) {
            eval {
                $self->_do({
                    type            => 'RESTORE',   # internal step type
                    version         => $from,
                    prev_version    => $from,
                    next_version    => $path[-1],
                }, 1);
                warn "Successfully undone interrupted migration by RESTORE $from\n";
                1;
            } or warn "Failed to RESTORE $from: $@";
        }
        die $err;
    };
    return;
}

sub _data2arg {
    my ($data) = @_;

    return if $data eq q{};

    my ($fh, $file) = tempfile('migrate.XXXXXX', TMPDIR=>1, UNLINK=>1);
    print {$fh} $data;
    close $fh or croak "close($file): $!";

    return $file;
}

sub _do {
    my ($self, $step, $is_fatal) = @_;
    local $ENV{MIGRATE_PREV_VERSION} = $step->{prev_version};
    local $ENV{MIGRATE_NEXT_VERSION} = $step->{next_version};
    eval {
        if ($step->{type} eq 'BACKUP' or $step->{type} eq 'RESTORE' or $step->{type} eq 'VERSION') {
            $self->{on}{ $step->{type} }->($step);
        }
        else {
            my $cmd = $step->{cmd};
            if ($cmd =~ /\A#!/ms) {
                $cmd = _data2arg($cmd);
                chmod 0700, $cmd or croak "chmod($cmd): $!";    ## no critic (ProhibitMagicNumbers)
            }
            system($cmd, @{ $step->{args} }) == 0 or die "'$step->{type}' failed: $cmd @{ $step->{args} }\n";
            print "\n";
        }
        1;
    }
    or do {
        die $@ if $is_fatal;
        warn $@;
        $self->{on}{error}->($step);
    };
    return;
}

sub _e {
    my ($t, $msg, $near) = @_;
    return "parse error: $msg at $t->{loc}{file}:$t->{loc}{line}"
      . (length $near ? " near '$near'\n" : "\n");
}

sub _find_paths {
    my ($self, $to, @from) = @_;
    my $p = $self->{paths}{ $from[-1] } || {};
    return [@from, $to] if $p->{$to};
    my %seen = map {$_=>1} @from;
    return map {$self->_find_paths($to,@from,$_)} grep {!$seen{$_}} keys %{$p};
}

sub _on_backup {
    croak 'You need to define how to make BACKUP';
}

sub _on_restore {
    croak 'You need to define how to RESTORE from backup';
}

sub _on_version {
    # do nothing
}

sub _on_error {
    warn <<'ERROR';

YOU NEED TO MANUALLY FIX THIS ISSUE RIGHT NOW
When done, use:
   exit        to continue migration
   exit 1      to interrupt migration and RESTORE from backup

ERROR
    system($ENV{SHELL} // '/bin/sh') == 0 or die "Migration interrupted\n";
    return;
}

sub _preprocess { ## no critic (ProhibitExcessComplexity)
    my @tokens = @_;
    my @op;
    my %macro;
    while (@tokens) {
        my $t = shift @tokens;
        if ($t->{op} =~ /\ADEFINE[24]?\z/ms) {

lib/App/migrate.pm  view on Meta::CPAN

=over

=item *

Be able to automatically make sure each 'upgrade' operation has
corresponding 'downgrade' operation (so it won't be forget - but, of
course, it's impossible to automatically check is 'downgrade' operation
will correctly undo effect of 'upgrade' operation).

I<Thus custom file format is needed.>

=item *

Make it easier to manually analyse is 'downgrade' operation looks correct
for corresponding 'upgrade' operation.

I<Thus related 'upgrade' and 'downgrade' operations must go one right
after another.>

=item *

Make it obvious some version can't be downgraded and have to be restored
from backup.

I<Thus RESTORE operation is named in upper case.>

=item *

Given all these requirements try to make it simple and obvious to define
migrate operations, without needs to write downgrade code for typical
cases.

I<Thus it's possible to define macro to turn combination of
upgrade/downgrade operations into one user-defined operation (no worries
here: these macro doesn't support recursion, it isn't possible to redefine
them, and they have lexical scope - from definition to the end of this
file - so they won't really add complexity).>

=back

=head2 Example

    VERSION 0.0.0
    # To upgrade from 0.0.0 to 0.1.0 we need to create new empty file and
    # empty directory.
    upgrade     touch   empty_file
    downgrade   rm      empty_file
    upgrade     mkdir   empty_dir
    downgrade   rmdir   empty_dir
    VERSION 0.1.0
    # To upgrade from 0.1.0 to 0.2.0 we need to drop old database. This
    # change can't be undone, so only way to downgrade from 0.2.0 is to
    # restore 0.1.0 from backup.
    upgrade     rm      useless.db
    RESTORE
    VERSION 0.2.0
    # To upgrade from 0.2.0 to 1.0.0 we need to run several commands,
    # and after downgrading we need to kill some background service.
    before_upgrade
      patch    <0.2.0.patch >/dev/null
      chmod +x some_daemon
    downgrade
      patch -R <0.2.0.patch >/dev/null
    upgrade
      ./some_daemon &
    after_downgrade
      killall -9 some_daemon
    VERSION 1.0.0

    # Let's define some lazy helpers:
    DEFINE2 only_upgrade
    upgrade
    downgrade true

    DEFINE2 mkdir
    upgrade
      mkdir "$@"
    downgrade
      rm -rf "$@"

    # ... and use it:
    only_upgrade
      echo "Just upgraded to $MIGRATE_NEXT_VERSION"

    VERSION 1.0.1

    # another lazy macro (must be defined above in same file)
    mkdir dir1 dir2

    VERSION 1.1.0

=head2 Specification

Recommended name for file with upgrade/downgrade operations is either
C<migrate> or C<< <version>.migrate >>.

Each line in migrate file must be one of these:

=over

=item * line start with symbol "#"

For comments. Line is ignored.

=item * line start with any non-space symbol, except "#"

Contain one or more elements separated by one or more space symbols:
operation name (case-sensitive), zero or more params (any param may be
quoted, params which contain one of 5 symbols "\\\"\t\r\n" must be
quoted).

Quoted params must be surrounded by double-quote symbol, and any of
mentioned above 5 symbols must be escaped like shown above.

=item * line start with two spaces

Zero or more such lines after line with operation name form one more,
multiline, extra param for that operation (first two spaces will be
removed from start of each line before providing this param to operation).

Not all operations may have such multiline param.