RT#47865, RT#56783, RT#52474 by properly capturing --help, --usage, --?.
Details in the test cases.
Revision history for Perl extension MooseX-Getopt
+ * MooseX::Getopt::Basic
+ - store the usage object to the usage attr (RT#58715)
+ - properly checks whether the *option* --help, --usage, or --? were used,
+ rather than the attribute 'help', 'usage' or '?' were set
+ * MooseX::Getopt::GLD
+ - add the usage attribute for storing the Getopt::Long::Descriptive::Usage
+ object, and the help attribute for storing --help, --usage and --? state
+ (RT#47865, RT#56783, RT#52474). (Karen Etheridge)
* MooseX::Getopt::Basic
- Disable auto_help config in Getopt::Long, to avoid calling into
pod2usage when the --help option is used while MooseX::ConfigFromFile
is in use (the intent is just to fetch the value of the configfile
- option). (RT#57683) (Karen Etheridge)
+ option) (RT#57683). (Karen Etheridge)
0.29 Tue. Jun 15 2010
* Fix repository metadata. Thanks Robert Bohne for noticing!
If L<Getopt::Long::Descriptive> is installed and any of the following
command line params are passed, the program will exit with usage
-information. You can add descriptions for each option by including a
+information (and the option's state will be stored in the help_flag
+attribute). You can add descriptions for each option by including a
B<documentation> option for each attribute to document.
--?
--usage
If you have L<Getopt::Long::Descriptive> the C<usage> param is also passed to
-C<new>.
+C<new> as the usage option.
=method B<ARGV>
L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
un-mangled.
+=method B<usage>
+
+This accessor contains the L<Getopt::Long::Descriptive::Usage> object (if
+L<Getopt::Long::Descriptive> is used).
+
+=method B<help_flag>
+
+This accessor contains the boolean state of the --help, --usage and --?
+options (true if any of these options were passed on the command line).
+
=method B<meta>
This returns the role meta object.
my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
# did the user request usage information?
- if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )
+ if ( $processed{usage} and $params->{help_flag} )
{
$class->_getopt_full_usage($processed{usage});
}
$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
);
with 'MooseX::Getopt::Basic';
+has usage => (
+ is => 'rw', isa => 'Getopt::Long::Descriptive::Usage',
+ traits => ['NoGetopt'],
+);
+
+# captures the options: --help --usage --?
+has help_flag => (
+ is => 'ro', isa => 'Bool',
+ traits => ['Getopt'],
+ cmd_flag => 'help',
+ cmd_aliases => [ qw(usage ?) ],
+ documentation => 'Prints this usage information.',
+);
+
around _getopt_spec => sub {
shift;
shift->_gld_spec(@_);
with 'MooseX::Getopt';
has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' );
- has help => ( isa => 'Bool', is => 'ro', default => 0, documentation => 'Help');
our $usage = 0;
before _getopt_full_usage => sub { $usage++; };
my $exp = [
'Unknown option: q
',
- qq{usage: 104_override_usage.t [long options...]
-\t--help Help
-\t--foo A foo
+ qq{usage: 104_override_usage.t [-?] [long options...]
+\t-? --usage --help Prints this usage information.
+\t--foo A foo
}
];
},
);
- # only here to avoid an "unknown option: help" warning
- has help => (
- is => 'ro', isa => 'Bool',
- );
-
no Moose;
1;
}
warning_like {
throws_ok { Class->new_with_options }
- qr/^usage: [\d\w]+\Q.t [long options...]\E.\t--configfile\s*.\t--help/ms,
+ #usage: 107_no_auto_help.t [-?] [long options...]
+ qr/^usage: [\d\w]+\Q.t [-?] [long options...]\E.\t--configfile\s*.\t\Q-? --usage --help Prints this usage information.\E/ms,
'usage information looks good';
}
qr/^Specified configfile \'this_value_unimportant\' does not exist, is empty, or is not readable$/,
--- /dev/null
+#!/usr/bin/env perl
+
+# Re RT#58715 and the claim in the documentation:
+# If you have Getopt::Long::Descriptive the usage param is also passed to new.
+
+# This tests the fix (that fulfills the documentation claim).
+
+use strict; use warnings;
+use Test::More tests => 3;
+
+{
+ package MyClass;
+ use strict; use warnings;
+ use Moose;
+ with 'MooseX::Getopt';
+}
+
+Moose::Meta::Class->create('MyClassWithBasic',
+ superclasses => ['MyClass'],
+ roles => [ 'MooseX::Getopt::Basic' ],
+);
+
+my $basic_obj = MyClassWithBasic->new_with_options();
+ok(!$basic_obj->meta->has_attribute('usage'), 'basic class has no usage attribute');
+
+Moose::Meta::Class->create('MyClassWithGLD',
+ superclasses => ['MyClass'],
+ roles => [ 'MooseX::Getopt' ],
+);
+
+my $gld_obj = MyClassWithGLD->new_with_options();
+
+ok($gld_obj->meta->has_attribute('usage'), 'class has usage attribute');
+isa_ok($gld_obj->usage, 'Getopt::Long::Descriptive::Usage');
+
--- /dev/null
+#!/usr/bin/env perl
+
+# The documentation claims:
+# If Getopt::Long::Descriptive is installed and any of the following command
+# line params are passed (--help, --usage, --?), the program will exit with
+# usage information...
+
+# This is not actually true (as of 0.29), as:
+# 1. the consuming class must set up a attributes named 'help', 'usage' and
+# '?' to contain these command line options, which is not clearly
+# documented as a requirement
+# 2. the code is checking whether an option was parsed into an attribute
+# *called* 'help', 'usage' or '?', not whether the option --help, --usage
+# or --? was passed on the command-line (the mapping could be different,
+# if cmd_flag or cmd_aliases is used),
+
+# This inconsistency is the underlying cause of RT#52474, RT#57683, RT#47865.
+
+use strict; use warnings;
+use Test::More tests => 6;
+use Test::Exception;
+
+{
+ package MyClass;
+ use strict; use warnings;
+ use Moose;
+ with 'MooseX::Getopt';
+}
+
+# before fix, prints this on stderr:
+#Unknown option: ?
+#usage: test1.t
+
+# after fix, prints this on stderr:
+#usage: test1.t [-?] [long options...]
+# -? --usage --help Prints this usage information.
+
+foreach my $args ( ['--help'], ['--usage'], ['--?'], ['-?'] )
+{
+ local @ARGV = @$args;
+
+ throws_ok { MyClass->new_with_options() }
+ qr/^usage: (?:[\d\w]+)\Q.t [-?] [long options...]\E.^\t\Q-? --usage --help Prints this usage information.\E$/ms,
+ 'Help request detected; usage information properly printed';
+}
+
+# now call again, and ensure we got the usage info.
+my $obj = MyClass->new_with_options();
+ok($obj->meta->has_attribute('usage'), 'class has usage attribute');
+isa_ok($obj->usage, 'Getopt::Long::Descriptive::Usage');
+
projects / gitmo/MooseX-Getopt.git / commitdiff