File Coverage

blib/lib/App/JobLog/Command.pm

Criterion	Covered	Total	%
statement	19	45	42.2
branch	1	14	7.1
condition			n/a
subroutine	8	13	61.5
pod	3	8	37.5
total	31	80	38.7

package App::JobLog::Command;
$App::JobLog::Command::VERSION = '1.041';
# ABSTRACT: common functionality of App::JobLog commands

use App::Cmd::Setup -command;
use Modern::Perl;
use App::JobLog::Config qw(columns);

sub opt_spec {
    my ( $class, $app ) = @_;

    return ( $class->options($app), [ 'help' => "this usage screen" ] );
}

# makes sure everything has some sort of description
sub description {
    my ($self) = @_;

    # abstract provides default text
    my $desc = $self->full_description;
    unless ($desc) {
        ( $desc = $self->abstract ) =~ s/^\s++|\s++$//g;

        # ensure initial capitalization
        $desc =~ s/^(\p{Ll})/uc $1/e;

        # add sentence-terminal punctuation as necessary
        $desc =~ s/(\w)$/$1./;
    }

    # make sure things are wrapped nicely
    _wrap( \$desc );

    # space between description and options text
    $desc .= "\n";
    return $desc;
}

# performs text wrapping while preserving the formatting of lines beginning with whitespace
sub _wrap {
    my $desc = shift;
    require Text::WrapI18N;
    $Text::WrapI18N::columns = columns;
    my ( $current, @gathered );
    for my $line ( $$desc =~ /^(.*?)\s*$/mg ) {
        if ( $line =~ /^\S/ ) {
            if ($current) {
                $current .= " $line";
            }
            else {
                $current = $line;
            }
        }
        else {
            push @gathered, Text::WrapI18N::wrap( '', '', $current )
              if defined $current;
            push @gathered, $line;
            $current = undef;
        }
    }
    push @gathered, Text::WrapI18N::wrap( '', '', $current )
      if defined $current;
    $$desc = join "\n", @gathered;
}

# override to make full description
sub full_description { }

sub validate_args {
    my ( $self, $opt, $args ) = @_;
    die $self->_usage_text if $opt->{help};
    $self->validate( $opt, $args );
}

# obtains command name
sub name {
    ( my $command = shift ) =~ s/.*:://;
    return $command;
}

# by default a command has no options other than --help
sub options { }

# by default a command does no argument validation
sub validate { }

# add to simple commands after argument signature so they'll complain if given arguments
sub simple_command_check {
    my ( $self, $args ) = @_;
    $self->usage_error("This command does not expect any arguments! No action taken.") if @$args;
}

1;

__END__