File Coverage

blib/lib/MooX/Role/CliOptions.pm

Criterion	Covered	Total	%
statement	43	46	93.4
branch	13	20	65.0
condition	9	14	64.2
subroutine	9	10	90.0
pod	1	1	100.0
total	75	91	82.4

package MooX::Role::CliOptions;

use 5.006;
use strict;
use warnings;

use Carp qw( croak );

use Getopt::Long v2.36 qw(GetOptionsFromArray);
use Pod::Usage;

# this could have been replaced with hand-rolled "isa" clauses, but if
# one is using Moo then the odds are good that one already has this
use Types::Standard qw( ArrayRef Bool );

use Moo::Role;

our $VERSION = '0.04.1_004';

my @options = ( 'help', 'man' );
do {
    has debug => (
        is      => 'ro',
        isa     => Bool,
        default => 1,
    );

    has verbose => (
        is      => 'ro',
        isa     => Bool,
        default => 1,
    );

    push( @options, qw( debug! verbose! ) );
} unless $ENV{MRC_NO_STDOPTS};

has argv => (
    is  => 'ro',
    isa => ArrayRef,
);

sub init {
    my $class = shift;
    my %args  = @_;

    my $argv = delete( $args{argv} ) or croak q{'argv' argument is required};
    croak q{'argv' must be an array reference'}
      unless ref($argv) && ref($argv) eq 'ARRAY';

    my $add_opts = delete( $args{add_opts} ) || [];
    croak q{'add_opts' must be an array reference'}
      unless ref($add_opts) && ref($add_opts) eq 'ARRAY';

    croak q{unknown argument supplied for 'init'} if keys(%args);

    push( @options, $_ ) for ( @{$add_opts} );

    my %values;
    GetOptionsFromArray( $argv, \%values, @options ) or _pod2usage(2);
    _pod2usage(1) if $values{help};
    _pod2usage( -exitstatus => 0, -verbose => 2 ) if $values{man};

    $values{argv} = $argv;

    do {
        # have (no)debug imply verbose if that is not not specificed.
        # This is a # personal preference based on my experience of how
        # these options are most commonly used.
        $values{verbose} ||= $values{debug}
          if defined( $values{debug} ) && !defined( $values{verbose} );
    } unless $ENV{MRC_NO_STDOPTS};

    my $app = eval { $class->new(%values); };
    do {
        print $@ . "\n";
        _pod2usage(2);
    } if $@;

    return $app;
}

# this is needed so test scripts can intercept the call to pod2usage and
# prevent the exit from happening
sub _pod2usage {
    pod2usage(@_);
}

1;    # End of MooX::Role::CliOptions
__END__