1 package MooseX::Getopt::GLD;
2 # ABSTRACT: A Moose role for processing command line options with Getopt::Long::Descriptive
4 use MooseX::Role::Parameterized;
6 use Getopt::Long::Descriptive 0.081;
8 with 'MooseX::Getopt::Basic';
10 parameter getopt_conf => (
11 isa => 'ArrayRef[Str]',
12 default => sub { [] },
18 my $getopt_conf = $p->getopt_conf;
21 is => 'rw', isa => 'Getopt::Long::Descriptive::Usage',
22 traits => ['NoGetopt'],
25 # captures the options: --help --usage --?
27 is => 'ro', isa => 'Bool',
30 cmd_aliases => [ qw(usage ?) ],
31 documentation => 'Prints this usage information.',
34 around _getopt_spec => sub {
39 around _getopt_get_options => sub {
41 my ($class, $params, $opt_spec) = @_;
42 # Check if a special args hash were already passed, or create a new one
43 my $args = ref($opt_spec->[-1]) eq 'HASH' ? pop @$opt_spec : {};
44 unshift @{$args->{getopt_conf}}, @$getopt_conf;
45 push @$opt_spec, $args;
46 return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec);
49 method _gld_spec => sub {
50 my ( $class, %params ) = @_;
52 my ( @options, %name_to_init_arg );
54 my $constructor_params = $params{params};
56 foreach my $opt ( @{ $params{options} } ) {
59 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
61 ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
63 # remove this 'feature' because it didn't work
64 # all the time, and so is better to not bother
65 # since Moose will handle the defaults just
68 #( exists $opt->{default} ? (default => $opt->{default}) : () ),
72 my $identifier = lc($opt->{name});
73 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
75 $name_to_init_arg{$identifier} = $opt->{init_arg};
78 return ( \@options, \%name_to_init_arg );
91 with 'MooseX::Getopt::GLD';
95 with 'MooseX::Getopt::GLD' => { getopt_conf => [ 'pass_through', ... ] };
97 has 'out' => (is => 'rw', isa => 'Str', required => 1);
98 has 'in' => (is => 'rw', isa => 'Str', required => 1);
100 # ... rest of the class here
107 my $app = My::App->new_with_options();
108 # ... rest of the script here
110 ## on the command line
111 % perl my_app_script.pl -in file.input -out file.dump
115 This role is a parameterized role. It accepts one configuration parameter,
116 C<getopt_conf>. This parameter is an ArrayRef of strings, which are
117 L<Getopt::Long> configuraion options (see "Configuring Getopt::Long" in