libmoox-options-perl 4.012-1 / usr / share / perl5 / MooX / Options.pm

#
# This file is part of MooX-Options
#
# This software is copyright (c) 2013 by celogeek <me@celogeek.com>.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package MooX::Options;

# ABSTRACT: Explicit Options eXtension for Object Class

use strict;
use warnings;
our $VERSION = '4.012';    # VERSION
use Carp;

my @OPTIONS_ATTRIBUTES
    = qw/format short repeatable negativable autosplit doc long_doc order json/;

sub import {
    my ( undef, @import ) = @_;
    my $options_config = {
        protect_argv          => 1,
        flavour               => [],
        skip_options          => [],
        prefer_commandline    => 0,
        with_config_from_file => 0,

        #long description (manual)
        description => undef,
        authors     => [],
        synopsis    => undef,
        @import
    };

    my $target = caller;
    for my $needed_methods (qw/with around has/) {
        next if $target->can($needed_methods);
        croak
            "Can't find the method <$needed_methods> in <$target> ! Ensure to load a Role::Tiny compatible module like Moo or Moose before using MooX::Options.";
    }

    my $with   = $target->can('with');
    my $around = $target->can('around');
    my $has    = $target->can('has');

    my @target_isa;
    { no strict 'refs'; @target_isa = @{"${target}::ISA"} };

    if (@target_isa) {    #only in the main class, not a role

        use warnings FATAL => 'redefine';
        ## no critic (ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval, ValuesAndExpressions::ProhibitImplicitNewlines)
        eval '{
        package ' . $target . ';

            sub _options_data {
                my ( $class, @meta ) = @_;
                return $class->maybe::next::method(@meta);
            }

            sub _options_config {
                my ( $class, @params ) = @_;
                return $class->maybe::next::method(@params);
            }

        1;
        }';
        use warnings FATAL => qw/void/;

        croak $@ if $@;

        $around->(
            _options_config => sub {
                my ( $orig, $self ) = ( shift, shift );
                return $self->$orig(@_), %$options_config;
            }
        );

        ## use critic
    }
    else {
        if ( $options_config->{with_config_from_file} ) {
            croak
                'Please, don\'t use the option <with_config_from_file> into a role.';
        }
    }

    my $options_data = {};
    if ( $options_config->{with_config_from_file} ) {
        $options_data->{config_prefix} = {
            format => 's',
            doc    => 'config prefix',
            order  => 0,
        };
        $options_data->{config_files} = {
            format => 's@',
            doc    => 'config files',
            order  => 0,
        };
    }

    my $apply_modifiers = sub {
        return if $target->can('new_with_options');
        $with->('MooX::Options::Role');
        if ( $options_config->{with_config_from_file} ) {
            $with->('MooX::ConfigFromFile::Role');
        }

        $around->(
            _options_data => sub {
                my ( $orig, $self ) = ( shift, shift );
                return ( $self->$orig(@_), %$options_data );
            }
        );
    };

    my @banish_keywords
        = qw/help man usage option new_with_options parse_options options_usage _options_data _options_config/;
    if ( $options_config->{with_config_from_file} ) {
        push @banish_keywords, qw/config_files config_prefix config_dirs/;
    }

    my $option = sub {
        my ( $name, %attributes ) = @_;
        for my $ban (@banish_keywords) {
            croak
                "You cannot use an option with the name '$ban', it is implied by MooX::Options"
                if $name eq $ban;
        }

        $has->( $name => _filter_attributes(%attributes) );

        $options_data->{$name}
            = { _validate_and_filter_options(%attributes) };

        $apply_modifiers->();
        return;
    };

    if ( my $info = $Role::Tiny::INFO{$target} ) {
        $info->{not_methods}{$option} = $option;
    }

    { no strict 'refs'; *{"${target}::option"} = $option; }

    $apply_modifiers->();

    return;
}

sub _filter_attributes {
    my %attributes = @_;
    my %filter_key = map { $_ => 1 } @OPTIONS_ATTRIBUTES;
    return map { ( $_ => $attributes{$_} ) }
        grep { !exists $filter_key{$_} } keys %attributes;
}

sub _validate_and_filter_options {
    my (%options) = @_;
    $options{doc} = $options{documentation} if !defined $options{doc};
    $options{order} = 0 if !defined $options{order};

    if ( $options{json} ) {
        delete $options{repeatable};
        delete $options{autosplit};
        delete $options{negativable};
        $options{format} = 's';
    }

    my %cmdline_options = map { ( $_ => $options{$_} ) }
        grep { exists $options{$_} } @OPTIONS_ATTRIBUTES, 'required';

    $cmdline_options{repeatable} = 1 if $cmdline_options{autosplit};
    $cmdline_options{format} .= "@"
        if $cmdline_options{repeatable}
        && defined $cmdline_options{format}
        && substr( $cmdline_options{format}, -1 ) ne '@';

    croak
        "Negativable params is not usable with non boolean value, don't pass format to use it !"
        if $cmdline_options{negativable} && defined $cmdline_options{format};

    return %cmdline_options;
}

1;

__END__

=pod

=head1 NAME

MooX::Options - Explicit Options eXtension for Object Class

=head1 VERSION

version 4.012

=head1 DESCRIPTION

Create a command line tool with your L<Mo>, L<Moo>, L<Moose> objects.

Everything is explicit. You have an C<option> keyword to replace the usual C<has> to explicitly use your attribute into the command line.

The C<option> keyword takes additional parameters and uses L<Getopt::Long::Descriptive>
to generate a command line tool.

=head1 SYNOPSIS

In myOptions.pm :

  package myOptions;
  use Moo;
  use MooX::Options;
  
  option 'show_this_file' => (
      is => 'ro',
      format => 's',
      required => 1,
      doc => 'the file to display'
  );
  1;

In myTool.pl :

  use feature 'say';
  use myOptions;
  use Path::Class;
  
  my $opt = myOptions->new_with_options;
  
  say "Content of the file : ",
       file($opt->show_this_file)->slurp;

To use it :

  perl myTool.pl --show_this_file=myFile.txt
  Content of the file: myFile content

The help message :

  perl myTool.pl --help
  USAGE: myTool.pl [-h] [long options...]
  
      --show_this_file: String
          the file to display
      
      -h --help:
          show this help message
      
      --man:
          show the manual

The usage message :

  perl myTool.pl --usage
  USAGE: myTool.pl [ --show_this_file=String ] [ --usage ] [ --help ] [ --man ]

The manual :

  perl myTool.pl --man

=head1 IMPORTED METHODS

The list of the methods automatically imported into your class.

=head2 new_with_options

It will parse your command line params and your inline params, validate and call the C<new> method.

  myTool --str=ko

  t->new_with_options()->str # ko
  t->new_with_options(str => 'ok')->str #ok

=head2 option

The C<option> keyword replaces the C<has> method and adds support for special options for the command line only.

See L</OPTION PARAMETERS> for the documentation.

=head2 options_usage | --help

It displays the usage message and returns the exit code.

  my $t = t->new_with_options();
  my $exit_code = 1;
  my $pre_message = "str is not valid";
  $t->options_usage($exit_code, $pre_message);

This method is also automatically fired if the command option "--help" is passed.

  myTool --help

=head2 options_man | --man

It displays the manual.

  my $t = t->new_with_options();
  $t->options_man();

This is automatically fired if the command option "--man" is passed.

  myTool --man

=head2 options_short_usage | --usage

It displays a short version of the help message.

  my $t = t->new_with_options();
  $t->options_short_usage($exit_code);

This is automatically fired if the command option "--usage" is passed.

  myTool --usage

=head1 IMPORT PARAMETERS

The list of parameters supported by L<MooX::Options>.

=head2 flavour

Passes extra arguments for L<Getopt::Long::Descriptive>. It is useful if you
want to configure L<Getopt::Long>.

  use MooX::Options flavour => [qw( pass_through )];

Any flavour is passed to L<Getopt::Long> as a configuration, check the doc to see what is possible.

=head2 protect_argv

By default, C<@ARGV> is protected. If you want to do something else on it, use this option and it will change the real C<@ARGV>.

  use MooX::Options protect_argv => 0;

=head2 skip_options

If you have Role with options and you want to deactivate some of them, you can use this parameter.
In that case, the C<option> keyword will just work like an C<has>.

  use MooX::Options skip_options => [qw/multi/];

=head2 prefer_commandline

By default, arguments passed to C<new_with_options> have a higher priority than the command line options.

This parameter will give the command line an higher priority.

  use MooX::Options prefer_commandline => 1;

=head2 with_config_from_file

This parameter will load L<MooX::ConfigFromFile> in your module. 
The config option will be used between the command line and parameters.

myTool :

  use MooX::Options with_config_from_file => 1;

In /etc/myTool.json

  {"test" : 1}

=head1 OPTION PARAMETERS

The keyword C<option> extend the keyword C<has> with specific parameters for the command line.

=head2 doc | documentation

Documentation for the command line option.

=head2 long_doc

Documentation for the man page. By default the C<doc> parameter will be used.

See also L<Man parameters|MooX::Options::Manual::Man> to get more examples how to build a nice man page.

=head2 required

This attribute indicates that the parameter is mandatory.
This attribute is not really used by L<MooX::Options> but ensures that consistent error message will be displayed.

=head2 format

Format of the params, same as L<Getopt::Long::Descriptive>.

=over

=item * i : integer

=item * i@: array of integer

=item * s : string

=item * s@: array of string

=item * f : float value

=back

By default, it's a boolean value.

Take a look of available formats with L<Getopt::Long::Descriptive>.

You need to understand that everything is explicit here. 
If you use L<Moose> and your attribute has C<< isa => 'Array[Int]' >>, that will B<not> imply the format C<i@>.

=head2 format json : special format support

The parameter will be treated like a json string.

  option 'hash' => (is => 'ro', json => 1);

  myTool --hash='{"a":1,"b":2}' # hash = { a => 1, b => 2 }

=head2 negativable

It adds the negative version for the option.

  option 'verbose' => (is => 'ro', negativable => 1);

  myTool --verbose    # verbose = 1
  myTool --no-verbose # verbose = 0

=head2 repeatable

It appends to the L</format> the array attribute C<@>.

I advise to add a default value to your attribute to always have an array.
Otherwise the default value will be an undefined value.

  option foo => (is => 'rw', format => 's@', default => sub { [] });

  myTool --foo="abc" --foo="def" # foo = ["abc", "def"]

=head2 autosplit

For repeatable option, you can add the autosplit feature with your specific parameters.

  option test => (is => 'ro', format => 'i@', default => sub {[]}, autosplit => ',');
  
  myTool --test=1 --test=2 # test = (1, 2)
  myTool --test=1,2,3      # test = (1, 2, 3)

It will also handle quoted params with the autosplit.

  option testStr => (is => 'ro', format => 's@', default => sub {[]}, autosplit => ',');

  myTool --testStr='a,b,"c,d",e,f' # testStr ("a", "b", "c,d", "e", "f")

=head2 short

Long option can also have short version or aliased.

  option 'verbose' => (is => 'ro', short => 'v');

  myTool --verbose # verbose = 1
  myTool -v        # verbose = 1

  option 'account_id' => (is => 'ro', format => 'i', short => 'a|id');

  myTool --account_id=1
  myTool -a=1
  myTool --id=1

You can also use a shorter option without attribute :

  option 'account_id' => (is => 'ro', format => 'i');

  myTool --acc=1
  myTool --account=1

=head2 order

Specifies the order of the attribute. If you want to push some attributes at the end of the list.
By default all options have an order set to C<0>, and options are sorted by their names.

  option 'at_the_end' => (is => 'ro', order => 999);

=head1 ADDITIONAL MANUALS

=over

=item * L<Man parameters|MooX::Options::Manual::Man>

=item * L<Using namespace::clean|MooX::Options::Manual::NamespaceClean>

=item * L<Manage your tools with MooX::Cmd|MooX::Options::Manual::MooXCmd>

=back

=head1 EXTERNAL EXAMPLES

=over

=item * L<Slide3D about MooX::Options|http://perltalks.celogeek.com/slides/2012/08/moox-options-slide3d.html>

=back

=head1 THANKS

=over

=item Matt S. Trout (mst) <mst@shadowcat.co.uk> : For his patience and advice.

=item Tomas Doran (t0m) <bobtfish@bobtfish.net> : To help me release the new version, and using it :)

=item Torsten Raudssus (Getty) : to use it a lot in L<DuckDuckGo|http://duckduckgo.com> (go to see L<MooX> module also)

=item Jens Rehsack (REHSACK) : Use with L<PkgSrc|http://www.pkgsrc.org/>, and many really good idea (L<MooX::Cmd>, L<MooX::ConfigFromFile>, and more to come I'm sure)

=back

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
https://github.com/celogeek/MooX-Options/issues

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

celogeek <me@celogeek.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by celogeek <me@celogeek.com>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut