view release on metacpan or  search on metacpan

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

    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 => (
    is         => 'ro',
    isa        => ArrayRef[Tag],
    lazy       => 1,
    default    => sub { [] },
);

sub tags    { @{ shift->_tags } }
sub add_tag { push @{ shift->_tags } => @_ }

has _path_segments => (
    is       => 'ro',
    isa      => ArrayRef[Str],
    lazy     => 1,
    clearer  => 1, # Creates _clear_path_segments().
    default  => sub {
        my $self = shift;
        my @path = split m{/} => $self->name;
        my $ext  = '.' . $self->target->extension;
        if (my @rework_tags = $self->rework_tags) {
            # 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;
    }
);