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');
38 my (@opts, %cmd_flags_to_names);
40 foreach my $attr (@attrs) {
41 my $name = $attr->name;
43 my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
44 my $type = $getopt->_get_cmd_type_for_attr($attr);
46 $cmd_flags_to_names{$flag} = $name;
48 my $opt_string = join '|', $flag, @aliases;
49 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
52 $doc = $attr->documentation if $attr->has_documentation;
53 $doc = ' ' unless $doc;
55 my $is_required = !exists $getopt->params->{$name}
57 && !$attr->has_default
58 && !$attr->has_builder;
63 ( $is_required ? ( required => $attr->is_required ) : () ),
68 ### MooseX::Getopt::Parser::Descriptive::build_options @opts : @opts
71 local @ARGV = $getopt->argv;
72 ### MooseX::Getopt::Parser::Descriptive::build_options @ARGV : @ARGV
74 local $SIG{__WARN__} = sub {
75 return warn @_ if $_[0]=~/^\###/; # Smart::Comments
76 $getopt->strcat_warning( $_[0] )
80 ($options, $usage) = Getopt::Long::Descriptive::describe_options(
81 $self->format, @opts, { getopt_conf => [ $self->config ] }
85 $getopt->strcat_warning( $e ) if $e;
86 $getopt->status( ! $e );
88 my $extra_argv = \@ARGV;
89 $getopt->extra_argv( $extra_argv );
92 # Convert cmd_flags back to names in options hashref
95 $cmd_flags_to_names{$_} => $options->{$_}
99 #%options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
100 $getopt->options( $options );
102 ### MooseX::Getopt::Parser::Descriptive::build_options $options : $options
103 ### MooseX::Getopt::Parser::Descriptive::build_options $usage : $usage
104 ### MooseX::Getopt::Parser::Descriptive::build_options $getopt->status : $getopt->status
106 die join '', $getopt->warning if ($getopt->has_warning || !$getopt->status);