view release on metacpan or  search on metacpan

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

use App::Sqitch::X qw(hurl);
use Locale::TextDomain qw(App-Sqitch);

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

has name => (
    is       => 'ro',
    isa      => Str,
    required => 1,
);

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

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

has rspace => (
    is       => 'rwp',
    isa      => Str,
    default  => '',
);

has lopspace => (
    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;
    return $self->lspace
         . $self->format_content
         . $self->rspace
         . $self->format_note;
}

1;

__END__

=head1 Name

App::Sqitch::Plan::Line - Sqitch deployment plan line

=head1 Synopsis

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

=head1 Description

An App::Sqitch::Plan::Line represents a single line from a Sqitch plan file.
Each object managed by an L<App::Sqitch::Plan> object is derived from this
class. This is actually an abstract base class. See
L<App::Sqitch::Plan::Change>, L<App::Sqitch::Plan::Tag>, and
L<App::Sqitch::Plan::Blank> for concrete subclasses.

=head1 Interface

=head2 Constructors

=head3 C<new>

  my $plan = App::Sqitch::Plan::Line->new(%params);

Instantiates and returns a App::Sqitch::Plan::Line object. Parameters:

=over

=item C<plan>

The L<App::Sqitch::Plan> object with which the line is associated.

=item C<name>

The name of the line. Should be empty for blank lines. Tags names should
not include the leading C<@>.

=item C<lspace>

The white space from the beginning of the line, if any.

=item C<lopspace>