This returns the role meta object.
+=method B<process_argv (%params)>
+
+This does most of the work of C<new_with_options>, analyzing the parameters
+and argv, except for actually calling the constructor. It returns a
+L<MooseX::Getopt::ProcessedArgv> object. C<new_with_options> uses this
+method internally, so modifying this method via subclasses/roles will affect
+C<new_with_options>.
+
=cut
use MooseX::Getopt::OptionTypeMap;
use MooseX::Getopt::Meta::Attribute;
use MooseX::Getopt::Meta::Attribute::NoGetopt;
+use MooseX::Getopt::ProcessedArgv;
use Carp ();
use Getopt::Long 2.37 ();
has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
-sub new_with_options {
+sub process_argv {
my ($class, @params) = @_;
my $config_from_file;
$class->_getopt_full_usage($processed{usage});
}
+ return MooseX::Getopt::ProcessedArgv->new
+ (
+ argv_copy => $processed{argv_copy},
+ extra_argv => $processed{argv},
+ usage => $processed{usage},
+ constructor_params => $constructor_params, # explicit params to ->new
+ cli_params => $params, # params from CLI
+ );
+}
+
+sub new_with_options {
+ my ($class, @params) = @_;
+
+ my $pa = $class->process_argv(@params);
+
$class->new(
- ARGV => $processed{argv_copy},
- extra_argv => $processed{argv},
- ( $processed{usage} ? ( usage => $processed{usage} ) : () ),
- %$constructor_params, # explicit params to ->new
- %$params, # params from CLI
- );
+ ARGV => $pa->argv_copy,
+ extra_argv => $pa->extra_argv,
+ ( $pa->usage ? ( usage => $pa->usage ) : () ),
+ %{ $pa->constructor_params }, # explicit params to ->new
+ %{ $pa->cli_params }, # params from CLI
+ );
}
sub _getopt_spec { shift->_traditional_spec(@_); }
--- /dev/null
+package MooseX::Getopt::ProcessedArgv;
+use Moose;
+
+has 'argv_copy' => (is => 'ro', isa => 'ArrayRef');
+has 'extra_argv' => (is => 'ro', isa => 'ArrayRef');
+has 'usage' => (is => 'ro', isa => 'Maybe[Object]');
+has 'constructor_params' => (is => 'ro', isa => 'HashRef');
+has 'cli_params' => (is => 'ro', isa => 'HashRef');
+
+__PACKAGE__->meta->make_immutable();
+
+1;
+
+=pod
+
+=encoding utf-8
+
+=head1 NAME
+
+MooseX::Getopt::ProcessedArgv - contains result of process_argv
+
+=head1 SYNOPSIS
+
+ use My::App;
+
+ my $pa = My::App->process_argv(@params);
+ my $argv_copy = $pa->argv_copy();
+ my $extra_argv = $pa->extra_argv();
+ my $usage = $pa->usage();
+ my $constructor_params = $pa->constructor_params();
+ my $cli_params = $pa->cli_params();
+
+=head1 DESCRIPTION
+
+This object contains the result of a L<MooseX::Getopt/process_argv> call. It
+contains all the information that L<MooseX::Getopt/new_with_options> uses
+when calling new.
+
+=head1 METHODS
+
+=over
+
+=item argv_copy
+
+Reference to a copy of the original C<@ARGV> array as it originally existed
+at the time of C<new_with_options>.
+
+=item extra_arg
+
+Arrayref of leftover C<@ARGV> elements that L<Getopt::Long> did not parse.
+
+=item usage
+
+Contains the L<Getopt::Long::Descriptive::Usage> object (if
+L<Getopt::Long::Descriptive> is used).
+
+=item constructor_params
+
+Parameters passed to process_argv.
+
+=item cli_param
+
+Command-line parameters parsed out of C<@ARGV>.
+
+=back
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+Brandon L. Black, E<lt>blblack@gmail.comE<gt>
+
+Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
+
+=head1 CONTRIBUTORS
+
+Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
+
+Drew Taylor, E<lt>drew@drewtaylor.comE<gt>
+
+Tomas Doran, (t0m) C<< <bobtfish@bobtfish.net> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by Infinity Interactive, Inc.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+if ( !eval { require Test::Deep } )
+{
+ plan skip_all => 'Test requires Test::Deep';
+ exit;
+}
+else
+{
+ plan tests => 6;
+}
+
+{
+ package Testing::Foo;
+ use Moose;
+
+ with 'MooseX::Getopt';
+
+ has 'bar' => (
+ is => 'ro',
+ isa => 'Int',
+ required => 1,
+ );
+
+ has 'baz' => (
+ is => 'ro',
+ isa => 'Int',
+ required => 1,
+ );
+}
+
+@ARGV = qw(--bar 10 file.dat);
+
+my $pa;
+lives_ok {
+ $pa = Testing::Foo->process_argv(baz => 100);
+} '... this should work';
+isa_ok($pa, 'MooseX::Getopt::ProcessedArgv');
+
+Test::Deep::cmp_deeply($pa->argv_copy, [
+ '--bar',
+ '10',
+ 'file.dat'
+], 'argv_copy');
+Test::Deep::cmp_deeply($pa->cli_params, {
+ 'bar' => 10
+}, 'cli_params');
+Test::Deep::cmp_deeply($pa->constructor_params, {
+ 'baz' => 100
+}, 'constructor_params');
+Test::Deep::cmp_deeply($pa->extra_argv, [
+ 'file.dat'
+], 'extra_argv');