2 package MooseX::Getopt::Parser::Descriptive;
6 with 'MooseX::Getopt::Parser';
8 use MooseX::Getopt::OptionTypeMap;
10 use Getopt::Long::Descriptive ();
13 # Special configuration for parser
16 isa => 'ArrayRef[Str]',
17 default => sub { ['default'] },
20 # Format for usage description
24 default => 'usage: %c %o',
30 isa => 'Maybe[Getopt::Long::Descriptive::Usage]',
31 predicate => 'has_usage',
37 my ( $getopt, @attrs ) = @_;
39 Moose->throw_error("First argument is not a MooseX::Getopt::Session")
40 unless $getopt->isa('MooseX::Getopt::Session');
42 my $options = $getopt->options;
46 my ( @opts, %cmd_flags_to_names );
48 foreach my $attr (@attrs) {
49 my $name = $attr->name;
51 my ( $flag, @aliases ) = $getopt->_get_cmd_flags_for_attr($attr);
52 my $type = $getopt->_get_cmd_type_for_attr($attr);
54 my $opt_string = join '|', $flag, @aliases;
55 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
58 # opt_string is unmangled; parsed options keys are mangled
60 $cmd_flags_to_names{$flag} = $name;
63 $doc = $attr->documentation if $attr->has_documentation;
64 $doc = ' ' unless $doc;
66 my $is_required = !exists $options->{$name}
68 && !$attr->has_default
69 && !$attr->has_builder;
74 ( $is_required ? ( required => $attr->is_required ) : () ),
82 local @ARGV = @{ $getopt->ARGV };
84 local $SIG{__WARN__} = sub {
89 ( $new_options, $usage ) =
90 Getopt::Long::Descriptive::describe_options(
93 { getopt_conf => $self->config }
96 $warnings .= $@ if $@;
98 my $extra_argv = \@ARGV;
99 $getopt->extra_argv($extra_argv);
103 $self->usage( $usage );
105 # Convert cmd_flags back to names in options hashref
107 map { $cmd_flags_to_names{$_} => $new_options->{$_} }
111 # Include old options
112 $new_options = { %$options, %$new_options };
114 $getopt->status( ! $warnings );
115 $getopt->options( $new_options );
117 die $warnings if $warnings;
132 MooseX::Getopt::Parser::Descriptive - A Getopt::Long::Descriptive parser for MooseX::Getopt
136 use MooseX::Getopt::Parser::Descriptive;
138 my $parser = MooseX::Getopt::Parser::Descriptive->new(
139 format => 'Usage: %c %o',
140 config => ['pass_through']
142 my $getopt = MooseX::Getopt::Session->new( parser => $parser );
143 my $app = My::App->new( getopt => $getopt );
147 This class does L<MooseX::Getopt::Parser> for L<MooseX::Getopt>. This
148 class is used by default if L<Getopt::Long::Descriptive> module is
155 =item B<build_options ($getopt, @attrs)>
157 This method parses the CLI options with L<Getopt::Long> and returns a hashref to options list.
159 The first argument have to be L<MooseX::Getopt::Session> object and
160 second argument is a list of attributes which contains options.
164 This accessor contains the arrayref to list with special configuration
165 keywords for L<Getopt::Long>.
169 This accessor contains the string with message printed by
170 L<Getopt::Long::Descriptive> if error is occured.
176 All complex software has bugs lurking in it, and this module is no
177 exception. If you find a bug please either email me, or add the bug
184 =item L<MooseX::Getopt::Parser>
186 =item L<MooseX::Getopt::Parser::Default>
188 =item L<MooseX::Getopt::Parser::Long>
190 =item L<Getopt::Long::Descriptive>
196 Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
198 =head1 COPYRIGHT AND LICENSE
200 Copyright 2007-2008 by Infinity Interactive, Inc.
202 L<http://www.iinteractive.com>
204 This library is free software; you can redistribute it and/or modify
205 it under the same terms as Perl itself.