with 'MooseX::Getopt::Parser';
-sub getoptions {
- my ($class, $opt_spec) = @_;
+use Getopt::Long;
+use MooseX::Getopt::OptionTypeMap;
+
+#use Smart::Comments;
+
+# Special configuration for parser
+has 'config' => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ auto_deref => 1,
+ default => sub { [] },
+);
+
+
+sub build_options {
+ my $self = shift;
+ my ($getopt, @attrs) = @_;
+
+ Moose->throw_error('First argument is not a MooseX::Getopt::Session')
+ unless $getopt->isa('MooseX::Getopt::Session');
my %options;
+ my @opts;
+
+ foreach my $attr (@attrs) {
+ my $name = $attr->name;
+
+ my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
+ my $type = $getopt->_get_cmd_type_for_attr($attr);
+
+ my $opt_string = join '|', $flag, @aliases;
+ $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type);
+
+ $options{$name} = undef;
+ push @opts, $opt_string => \$options{$name};
+ };
+
+ ### MooseX::Getopt::Parser::Long::build_options @opts : @opts
+
+ GETOPT: {
+ my $parser = new Getopt::Long::Parser;
+ $parser->configure( $self->config );
+
+ local @ARGV = $getopt->argv;
+ ### MooseX::Getopt::Parser::Long::build_options @ARGV : @ARGV
- my $getopt = Getopt::Long::Parser->new;
- $getopt->getoptions(\%options, @$opt_spec);
- return ( \%options, undef );
-}
+ local $SIG{__WARN__} = sub {
+ return warn @_ if $_[0]=~/^\###/; # Smart::Comments
+ my $warning = $getopt->has_warning ? $getopt->warning : '';
+ $warning .= $_[0];
+ $getopt->warning( $warning )
+ };
-sub _get_getopt_spec {
- my ($class, %params) = @_;
+ my $status = $parser->getoptions( @opts );
+ $getopt->status( $status );
- my ( @options, %name_to_init_arg, %options );
+ my $extra_argv = \@ARGV;
+ $getopt->extra_argv( $extra_argv );
+ };
- foreach my $opt ( @{ $params{options} } ) {
- push @options, $opt->{opt_string};
+ %options = map { $_ => $options{$_} } grep { defined $options{$_} } keys %options;
+ $getopt->options( \%options );
- my $identifier = $opt->{name};
- $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
+ die join '', $getopt->warning if $getopt->has_warning;
- $name_to_init_arg{$identifier} = $opt->{init_arg};
- }
+ ### MooseX::Getopt::Parser::Long::build_options %options : %options
+ return \%options;
+};
- return ( \@options, \%name_to_init_arg );
-}
1;