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) if $type;
57 # opt_string is unmangled; parsed options key is mangled
59 $cmd_flags_to_names{$flag} = $name;
62 $doc = $attr->documentation if $attr->has_documentation;
63 $doc = ' ' unless $doc;
65 my $is_required = !exists $options->{$name}
67 && !$attr->has_default
68 && !$attr->has_builder;
73 ( $is_required ? ( required => $attr->is_required ) : () ),
81 local @ARGV = @{ $getopt->ARGV };
83 local $SIG{__WARN__} = sub {
88 ($new_options, $usage) = Getopt::Long::Descriptive::describe_options(
89 $self->format, @opts, { getopt_conf => $self->config }
93 $warnings .= $e if $e;
95 my $extra_argv = \@ARGV;
96 $getopt->extra_argv( $extra_argv );
100 $self->usage( $usage );
102 # Convert cmd_flags back to names in options hashref
103 $new_options = { map { $cmd_flags_to_names{$_} => $new_options->{$_} } keys %$new_options };
105 # Include old options
106 $new_options = { %$options, %$new_options };
108 $getopt->status( ! $warnings );
109 $getopt->options( $new_options );
111 die $warnings if $warnings;
125 MooseX::Getopt::Parser::Descriptive - A Getopt::Long::Descriptive parser for MooseX::Getopt
129 use MooseX::Getopt::Parser::Descriptive;
131 my $parser = MooseX::Getopt::Parser::Descriptive->new(
132 format => 'Usage: %c %o',
133 config => ['pass_through']
135 my $getopt = MooseX::Getopt::Session->new( parser => $parser );
136 my $app = My::App->new( getopt => $getopt );
140 This class does L<MooseX::Getopt::Parser> for L<MooseX::Getopt>. This
141 class is used by default if L<Getopt::Long::Descriptive> module is
148 =item B<build_options ($getopt, @attrs)>
150 This method parses the CLI options with L<Getopt::Long> and returns a hashref to options list.
152 The first argument have to be L<MooseX::Getopt::Session> object and
153 second argument is a list of attributes which contains options.
157 This accessor contains the arrayref to list with special configuration
158 keywords for L<Getopt::Long>.
162 This accessor contains the string with message printed by
163 L<Getopt::Long::Descriptive> if error is occured.
169 All complex software has bugs lurking in it, and this module is no
170 exception. If you find a bug please either email me, or add the bug
177 =item L<MooseX::Getopt::Parser>
179 =item L<MooseX::Getopt::Parser::Default>
181 =item L<MooseX::Getopt::Parser::Long>
183 =item L<Getopt::Long::Descriptive>
189 Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
191 =head1 COPYRIGHT AND LICENSE
193 Copyright 2007-2008 by Infinity Interactive, Inc.
195 L<http://www.iinteractive.com>
197 This library is free software; you can redistribute it and/or modify
198 it under the same terms as Perl itself.