2 package MooseX::Getopt::Parser::Long;
6 with 'MooseX::Getopt::Parser';
9 use MooseX::Getopt::OptionTypeMap;
13 # Special configuration for parser
16 isa => 'ArrayRef[Str]',
18 default => sub { [] },
24 my ($getopt, @attrs) = @_;
26 Moose->throw_error('First argument is not a MooseX::Getopt::Session')
27 unless $getopt->isa('MooseX::Getopt::Session');
32 foreach my $attr (@attrs) {
33 my $name = $attr->name;
35 my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
36 my $type = $getopt->_get_cmd_type_for_attr($attr);
38 my $opt_string = join '|', $flag, @aliases;
39 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
41 $options{$name} = undef;
42 push @opts, $opt_string => \$options{$name};
45 ### MooseX::Getopt::Parser::Long::build_options @opts : @opts
48 my $parser = new Getopt::Long::Parser;
49 $parser->configure( $self->config );
51 local @ARGV = $getopt->argv;
52 ### MooseX::Getopt::Parser::Long::build_options @ARGV : @ARGV
54 local $SIG{__WARN__} = sub {
55 return warn @_ if $_[0]=~/^\###/; # Smart::Comments
56 my $warning = $getopt->has_warning ? $getopt->warning : '';
58 $getopt->warning( $warning )
61 my $status = $parser->getoptions( @opts );
62 $getopt->status( $status );
64 my $extra_argv = \@ARGV;
65 $getopt->extra_argv( $extra_argv );
68 %options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
69 $getopt->options( \%options );
71 die join '', $getopt->warning if $getopt->die_on_warning && $getopt->has_warning;
73 ### MooseX::Getopt::Parser::Long::build_options %options : %options