App-Sqitch

 view release on metacpan or  search on metacpan

lib/App/Sqitch/Plan/Change.pm  view on Meta::CPAN

package App::Sqitch::Plan::Change;

use 5.010;
use utf8;
use namespace::autoclean;
use Encode;
use Moo;
use App::Sqitch::Types qw(Str Bool Maybe Change Tag Depend UserEmail DateTime ArrayRef);
use App::Sqitch::Plan::Depend;
use Locale::TextDomain qw(App-Sqitch);
extends 'App::Sqitch::Plan::Line';

our $VERSION = 'v1.6.1'; # VERSION

has _requires => (
    is       => 'ro',
    isa      => ArrayRef[Depend],
    init_arg => 'requires',
    default  => sub { [] },
);

sub requires { @{ shift->_requires } }

has _conflicts => (
    is       => 'ro',
    isa      => ArrayRef[Depend],
    init_arg => 'conflicts',
    default  => sub { [] },
);

sub conflicts { @{ shift->_conflicts } }

has pspace => (
    is       => 'ro',
    isa      => Str,
    default  => ' ',
);

has since_tag => (
    is       => 'ro',
    isa      => Tag,
);

has parent => (
    is       => 'ro',
    isa      => Change,
);

has _rework_tags => (
    is       => 'ro',
    isa      => ArrayRef[Tag],
    init_arg => 'rework_tags',
    lazy     => 1,
    default  => sub { [] },
);

sub rework_tags       { @{ shift->_rework_tags } }
sub add_rework_tags   { push @{ shift->_rework_tags } => @_ }
sub clear_rework_tags { @{ shift->_rework_tags } = () }
sub is_reworked       { @{ shift->_rework_tags } > 0 }

after add_rework_tags => sub {
    my $self = shift;
    # Need to reset the file name if a new value is passed.
    $self->_clear_path_segments(undef);
};

has _tags => (

lib/App/Sqitch/Plan/Change.pm  view on Meta::CPAN

            # Determine suffix based on the first one found in the deploy dir.
            my $dir = $self->deploy_dir;
            my $bn  = pop @path;
            my $first;
            for my $tag (@rework_tags) {
                my $fn = join '', $bn, $tag->format_name, $ext;
                $first //= $fn;
                if ( -e $dir->file(@path, $fn) ) {
                    push @path => $fn;
                    $first = undef;
                    last;
                }
            }
            push @path => $first if defined $first;
        } else {
            $path[-1] .= $ext;
        }
        return \@path;
    },
);

sub path_segments { @{ shift->_path_segments } }

has info => (
    is       => 'ro',
    isa      => Str,
    lazy     => 1,
    default  => sub {
        my $self = shift;
        my $reqs  = join "\n  + ", map { $_->as_string } $self->requires;
        my $confs = join "\n  - ", map { $_->as_string } $self->conflicts;
        return join "\n", (
            'project ' . $self->project,
            ( $self->uri ? ( 'uri ' . $self->uri->canonical ) : () ),
            'change '  . $self->format_name,
            ( $self->parent ? ( 'parent ' . $self->parent->id ) : () ),
            'planner ' . $self->format_planner,
            'date '    . $self->timestamp->as_string,
            ( $reqs  ? "requires\n  + $reqs" : ()),
            ( $confs ? "conflicts\n  - $confs" : ()),
            ( $self->note ? ('', $self->note) : ()),
        );
    }
);

has id => (
    is       => 'ro',
    isa      => Str,
    lazy     => 1,
    default  => sub {
        my $content = encode_utf8 shift->info;
        require Digest::SHA;
        return Digest::SHA->new(1)->add(
            'change ' . length($content) . "\0" . $content
        )->hexdigest;
    }
);

has timestamp => (
    is       => 'ro',
    isa      => DateTime,
    default  => sub { require App::Sqitch::DateTime && App::Sqitch::DateTime->now },
);

has planner_name => (
    is       => 'ro',
    isa      => Str,
    default  => sub { shift->sqitch->user_name },
);

has planner_email => (
    is       => 'ro',
    isa      => UserEmail,
    default  => sub { shift->sqitch->user_email },
);

has script_hash => (
    is       => 'ro',
    isa      => Maybe[Str],
    lazy     => 1,
    builder => '_deploy_hash'
);

sub dependencies {
    my $self = shift;
    return $self->requires, $self->conflicts;
}

sub deploy_dir {
    my $self = shift;
    my $target = $self->target;
    return $self->is_reworked
        ? $target->reworked_deploy_dir
        : $target->deploy_dir;
}

sub deploy_file {
    my $self = shift;
    $self->deploy_dir->file( $self->path_segments );
}

sub _deploy_hash {
    my $path = shift->deploy_file;
    return undef unless -f $path;
    require Digest::SHA;
    my $sha = Digest::SHA->new(1);
    $sha->add( $path->slurp(iomode => '<:raw') );
    return $sha->hexdigest;
}

sub revert_dir {
    my $self = shift;
    my $target = $self->target;
    return $self->is_reworked
        ? $target->reworked_revert_dir
        : $target->revert_dir;
}

sub revert_file {
    my $self = shift;
    $self->revert_dir->file( $self->path_segments );
}

lib/App/Sqitch/Plan/Change.pm  view on Meta::CPAN

        join "\n    ", '', @{ $p{scripts} },
        "\n",
    );
}

1;

__END__

=head1 Name

App::Sqitch::Plan::Change - Sqitch deployment plan tag

=head1 Synopsis

  my $plan = App::Sqitch::Plan->new( sqitch => $sqitch );
  for my $line ($plan->lines) {
      say $line->as_string;
  }

=head1 Description

A App::Sqitch::Plan::Change represents a change as parsed from a plan file. In
addition to the interface inherited from L<App::Sqitch::Plan::Line>, it offers
interfaces for parsing dependencies from the deploy script, as well as for
opening the deploy, revert, and verify scripts.

=head1 Interface

See L<App::Sqitch::Plan::Line> for the basics.

=head2 Accessors

=head3 C<since_tag>

An L<App::Sqitch::Plan::Tag> object representing the last tag to appear in the
plan B<before> the change. May be C<undef>.

=head3 C<pspace>

Blank space separating the change name from the dependencies, timestamp, and
planner in the file.

=head3 C<is_reworked>

Boolean indicting whether or not the change has been reworked.

=head3 C<info>

Information about the change, returned as a string. Includes the change ID,
the name and email address of the user who added the change to the plan, and
the timestamp for when the change was added to the plan.

=head3 C<id>

A SHA1 hash of the data returned by C<info()>, which can be used as a
globally-unique identifier for the change.

=head3 C<timestamp>

Returns the an L<App::Sqitch::DateTime> object representing the time at which
the change was added to the plan.

=head3 C<planner_name>

Returns the name of the user who added the change to the plan.

=head3 C<planner_email>

Returns the email address of the user who added the change to the plan.

=head3 C<parent>

Parent change object.

=head3 C<tags>

A list of tag objects associated with the change.

=head2 Instance Methods

=head3 C<path_segments>

  my @segments = $change->path_segments;

Returns the path segment for the change. For example, if the change is named
"foo", C<('foo.sql')> is returned. If the change is named "functions/bar>
C<('functions', 'bar.sql')> is returned. Internally, this data is used to
create the deploy, revert, and verify file names.

=head3 C<deploy_dir>

  my $file = $change->deploy_dir;

Returns the path to the deploy directory for the change.

=head3 C<deploy_file>

  my $file = $change->deploy_file;

Returns the path to the deploy script file for the change.

=head3 C<revert_dir>

  my $file = $change->revert_dir;

Returns the path to the revert directory for the change.

=head3 C<revert_file>

  my $file = $change->revert_file;

Returns the path to the revert script file for the change.

=head3 C<verify_dir>

  my $file = $change->verify_dir;

Returns the path to the verify directory for the change.

=head3 C<verify_file>