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]',
18 default => sub { [] },
21 # Format for usage description
25 default => 'usage: %c %o',
31 isa => 'Maybe[Getopt::Long::Descriptive::Usage]',
32 predicate => 'has_usage',
38 my ($getopt, @attrs) = @_;
40 Moose->throw_error('First argument is not a MooseX::Getopt::Session')
41 unless $getopt->isa('MooseX::Getopt::Session');
43 my $options = $getopt->options;
47 my (@opts, %cmd_flags_to_names);
49 foreach my $attr (@attrs) {
50 my $name = $attr->name;
52 my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
53 my $type = $getopt->_get_cmd_type_for_attr($attr);
55 my $opt_string = join '|', $flag, @aliases;
56 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type) if $type;
58 # opt_string is unmangled; parsed options key is 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 {
85 return warn @_ if $_[0]=~/^\###/; # Smart::Comments
90 ($new_options, $usage) = Getopt::Long::Descriptive::describe_options(
91 $self->format, @opts, { getopt_conf => [ $self->config ] }
95 $warnings .= $e if $e;
97 my $extra_argv = \@ARGV;
98 $getopt->extra_argv( $extra_argv );
102 $self->usage( $usage );
104 # Convert cmd_flags back to names in options hashref
105 $new_options = { map { $cmd_flags_to_names{$_} => $new_options->{$_} } keys %$new_options };
107 # Include old options
108 $new_options = { %$options, %$new_options };
110 $getopt->status( ! $warnings );
111 $getopt->options( $new_options );
113 die $warnings if $warnings;
127 MooseX::Getopt::Parser::Descriptive - A Getopt::Long::Descriptive parser for MooseX::Getopt
131 use MooseX::Getopt::Parser::Descriptive;
133 my $parser = MooseX::Getopt::Parser::Descriptive->new(
134 format => 'Usage: %c %o',
135 config => ['pass_through']
137 my $getopt = MooseX::Getopt::Session->new( parser => $parser );
138 my $app = My::App->new( getopt => $getopt );
142 This class does L<MooseX::Getopt::Parser> for L<MooseX::Getopt>. This
143 class is used by default if L<Getopt::Long::Descriptive> module is
150 =item B<build_options ($getopt, @attrs)>
152 This method parses the CLI options with L<Getopt::Long> and returns a hashref to options list.
154 The first argument have to be L<MooseX::Getopt::Session> object and
155 second argument is a list of attributes which contains options.
159 This accessor contains the arrayref to list with special configuration
160 keywords for L<Getopt::Long>.
164 This accessor contains the string with message printed by
165 L<Getopt::Long::Descriptive> if error is occured.
171 All complex software has bugs lurking in it, and this module is no
172 exception. If you find a bug please either email me, or add the bug
179 =item L<MooseX::Getopt::Parser>
181 =item L<MooseX::Getopt::Parser::Default>
183 =item L<MooseX::Getopt::Parser::Long>
185 =item L<Getopt::Long::Descriptive>
191 Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
193 =head1 COPYRIGHT AND LICENSE
195 Copyright 2007-2008 by Infinity Interactive, Inc.
197 L<http://www.iinteractive.com>
199 This library is free software; you can redistribute it and/or modify
200 it under the same terms as Perl itself.