2 package MooseX::Getopt::Parser::Descriptive;
6 with 'MooseX::Getopt::Parser';
8 use Getopt::Long::Descriptive;
9 use MooseX::Getopt::OptionTypeMap;
13 # Special configuration for parser
16 isa => 'ArrayRef[Str]',
18 default => sub { [] },
21 # Format for usage description
25 default => 'usage: %c %o',
31 my ($getopt, @attrs) = @_;
33 Moose->throw_error('First argument is not a MooseX::Getopt::Session')
34 unless $getopt->isa('MooseX::Getopt::Session');
36 my ($options, $usage);
39 foreach my $attr (@attrs) {
40 my $name = $attr->name;
42 my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
43 my $type = $getopt->_get_cmd_type_for_attr($attr);
45 my $opt_string = join '|', $flag, @aliases;
46 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
49 $doc = $attr->documentation if $attr->has_documentation;
50 $doc = ' ' unless $doc;
52 my $is_required = $attr->is_required && !$attr->has_default && !$attr->has_builder;
57 ( $is_required ? ( required => $attr->is_required ) : () ),
62 ### MooseX::Getopt::Parser::Descriptive::build_options @opts : @opts
65 local @ARGV = $getopt->argv;
66 ### MooseX::Getopt::Parser::Descriptive::build_options @ARGV : @ARGV
68 local $SIG{__WARN__} = sub {
69 return warn @_ if $_[0]=~/^\###/; # Smart::Comments
70 $getopt->strcat_warning( $_[0] )
74 ($options, $usage) = Getopt::Long::Descriptive::describe_options(
75 $self->format, @opts, { getopt_conf => [ $self->config ] }
79 $getopt->strcat_warning( $e ) if $e;
80 $getopt->status( ! $e );
82 my $extra_argv = \@ARGV;
83 $getopt->extra_argv( $extra_argv );
86 #%options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
87 $getopt->options( defined $options ? $options : {} );
89 ### MooseX::Getopt::Parser::Descriptive::build_options $options : $options
90 ### MooseX::Getopt::Parser::Descriptive::build_options $usage : $usage
91 ### MooseX::Getopt::Parser::Descriptive::build_options $getopt->status : $getopt->status
93 die join '', $getopt->warning
94 if $getopt->die_on_warning && ($getopt->has_warning || !$getopt->status);