view release on metacpan or  search on metacpan

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

    is       => 'ro',
    isa      => Str,
    default  => '',
);

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

has note => (
    is       => 'rw',
    isa      => Str,
    default  => '',
);

after note => sub {
    my $self = shift;
    $self->_set_rspace(' ') if $_[0] && !$self->rspace;
};

has plan => (
    is       => 'ro',
    isa      => Plan,
    weak_ref => 1,
    required => 1,
    handles  => [qw(sqitch project uri target)],
);

my %escape = (
    "\n" => '\\n',
    "\r" => '\\r',
    '\\' => '\\\\',
);

my %unescape = reverse %escape;

sub BUILDARGS {
    my $class = shift;
    my $p = @_ == 1 && ref $_[0] ? { %{ +shift } } : { @_ };
    if (my $note = $p->{note}) {
        # Trim and then encode newlines.
        $note =~ s/\A\s+//;
        $note =~ s/\s+\z//;
        $note =~ s/(\\[\\nr])/$unescape{$1}/g;
        $p->{note} = $note;
        $p->{rspace} //= ' ' if $note && $p->{name};
    }
    return $p;
}

sub request_note {
    my ( $self, %p ) = @_;
    my $note = $self->note // '';
    return $note if $note =~ /\S/;

    # Edit in a file.
    require File::Temp;
    my $tmp = File::Temp->new;
    binmode $tmp, ':utf8_strict';
    ( my $prompt = $self->note_prompt(%p) ) =~ s/^/# /gms;
    $tmp->print( "\n", $prompt, "\n" );
    $tmp->close;

    my $sqitch = $self->sqitch;
    $sqitch->shell( $sqitch->editor . ' ' . $sqitch->quote_shell($tmp) );

    open my $fh, '<:utf8_strict', $tmp or hurl add => __x(
        'Cannot open {file}: {error}',
        file  => $tmp,
        error => $!
    );

    $note = join '', grep { $_ !~ /^\s*#/ } <$fh>;
    hurl {
        ident   => 'plan',
        message => __ 'Aborting due to empty note',
        exitval => 1,
    } unless $note =~ /\S/;

    # Trim the note.
    $note =~ s/\A\v+//;
    $note =~ s/\v+\z//;

    # Set the note.
    $self->note($note);
    return $note;
}

sub note_prompt {
    my ( $self, %p ) = @_;
    __x(
        "Write a {command} note.\nLines starting with '#' will be ignored.",
        command => $p{for}
    );
}

sub format_name {
    shift->name;
}

sub format_operator {
    my $self = shift;
    join '', $self->lopspace, $self->operator, $self->ropspace;
}

sub format_content {
    my $self = shift;
    join '', $self->format_operator, $self->format_name;
}

sub format_note {
    my $note = shift->note;
    return '' unless length $note;
    $note =~ s/([\r\n\\])/$escape{$1}/g;
    return "# $note";
}

sub as_string {
    my $self = shift;