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_002';

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__

=pod

=head1 NAME

MooX::Role::CliOptions - Wrapper to simplify using Moo with Getopt::Long

=head1 VERSION

Version 0.04.1_002

=head1 SYNOPSIS

This is a minimal script that composes C<MooX::Role::CliOptions>.
  
    #!perl!
    package My::CliOptions;
  
    use Moo;
    with 'MooX::Role::CliOptions';
  
    # initialize script attributes/variables
    has option1 => (
        is => 'ro',
        isa => sub {
            die 'Illegal value for option1'
              unless $_[0] =~ /^foo|bar$/;
        },
    );
  
    ...
  
    # this is what makes the script a modulino
    do {
        my $app = __PACKAGE__->init(
            argv     => \@ARGV,
            add_opts => [ 'option1=s' ],
        );
        exit $app->run;
    } unless caller();
  
    sub run {
        my $self = shift;
  
        ...
  
        return 0;
    }
  
    1; # must be present to satisfy "require" when testing
    __END__
  
=head1 DESCRIPTION

This role was written to help standardize command line script behavior and
greatly improve their testability.

=head1 EXPORTS

None.

=head1 ATTRIBUTES

Three attributes are provided for the composing package, two of which are
accepted as command line arguments and the third being created from the final
C<@ARGV> values after processing by C<Getopt::Long>.

NOTE: Both C<--debug> and C<--verbose> can be disabled by setting the
environment variable C<MRC_NO_STDOPTS> to a "true" value B<before> composing
C<MooX::Role::CliOptions> into you script. This allows you to completely remove
them or redefine them to suit your needs if so desired. I.e. you might want
C<--debug> to be "off" by default. If you decide to redefine them you must
supply a suitable attribute in your script. This does NOT affect C<--help>
or C<--man>.
  
 #!perl!
  
 # redefine --debug to be off by default and --verbose to indicate a level
 # between 0 and 5
 BEGIN {
    $ENV{MRC_NO_STDOPTS} = 1;
 }
  
 has debug => (
    is => 'ro',
    default => 0,
 );
  
 has verbose => (
    is => 'ro',
    isa => sub {
        die 'illegal value for --verbose'
          unless $_[0] >= 0 && $_[0] <= 5;
    },
    default => 0,
 );
  
 use Moo;
 with 'MooX::Role::CliOptions';
  
 do {
    my $app = __PACKAGE__->init(
        argv => \@ARGV,
        add_opts => [
            'debug',
            'verbose=i',
        ],
    );
  
    exit $app->run;
 } unless caller();
  
 ...
  
=head2 debug (Boolean read-only)

Commonly used to either enable extra reports and/or disable potentially
dangerous operations such as database modifications.

Default: ON. Is turned off with C<--nodebug> on the command line.

Note: Implies the setting for C<verbose> if C<--verbose> or C<--noverbose> is
not explicitly set on the command line.

=head2 verbose (Boolean read-only)

Tyically used to add extra information to the output. Often used in
conjunction with CL--debug>.

Default: Will be the same as C<debug> if not explicitly set with either
C<--verbose> or C<--noverbose>. This behaviour was chosen since that is
the most common usage in the author's experience.

The most likely patter would be
  
 # in a crontab where no visible output would be desired
 /my_script --nodebug
  
 # manually run from the cli if screen output is desired
 /my_script --nodebug --verbose

=head2 argv (read-only)

Returns an arrayref to the contents of C<@ARGV> after processing by
C<Getopt::Long>.

=head1 OTHER COMMAND LINE ARGUMENTS

=head2 --help

Will use C<pod2usage> to display the C<SYNOPSIS> or C<USAGE> POD section if
available.

=head2 --man

Will use C<pod2usage> to display the full POD if available.

=head1 METHODS

=head2 init

This is the workhorse that performs necessary actions and makes the actual
call to the composing package's C<new> constructor. Its return value is
the resulting object of the composing package type.

=head3 Parameters

=over 4

=item argv (required)

Typically passed in as follows:
  
 my $app = __PACKAGE__->init( argv => \@ARGV );
  
This will be passed to C<Getopt::Long> for processing. Any remaining elements
will be left in C<@ARGV>. They can also be accessed via C<$app-E<gt>argv>.

=item add_opts (optional)

You can add your own command line options by using this. Simply place the
specifications for any additional options that you want in an array ref as
shown below and be sure to declare an attribute to hold the option data
as processed by C<Getopt::Long>. (See the example script to make things clear.)
  
 # in your script
 has custom1 => (
    is => 'ro',
    isa => sub { ... },
 );
  
 do {
    my $app = __PACKAGE__->init(
        argv => \@ARGV,
        add_opts => [
            'custom1=s',
        ],
    );
    exit ($app->run || 0);
 } unless caller();
  
The above snippet would tell C<Getopt::Long> to accept a command line option
named C<custom1> that must be a string and place it in the C<custom1>
attribute that was declared. You may use any kind of C<isa> or C<coerce>
test that you deem are needed as well as a default.

=back

=head1 SEE ALSO

C<examples/moodulino.pl> for a fully functional script,

=head1 AUTHOR

Jim Bacon, C<< <boftx at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-moox-role-clioptions at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooX-Role-CliOptions>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc MooX::Role::CliOptions


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=MooX-Role-CliOptions>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/MooX-Role-CliOptions>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/MooX-Role-CliOptions>

=item * Search CPAN

L<https://metacpan.org/release/MooX-Role-CliOptions>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2019 Jim Bacon.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=cut
