From: Karen Etheridge Date: Sun, 27 Jun 2010 19:58:00 +0000 (-0700) Subject: Implements feature suggestion RT#58715 by storing the Usage object, fixes X-Git-Tag: 0.30~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81b19ed83c9e345f960ccefbcd639dd0e3c2de06;p=gitmo%2FMooseX-Getopt.git Implements feature suggestion RT#58715 by storing the Usage object, fixes RT#47865, RT#56783, RT#52474 by properly capturing --help, --usage, --?. Details in the test cases. --- diff --git a/ChangeLog b/ChangeLog index 15ac206..1bf3778 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,18 @@ 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! diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 49b47b9..fdd4263 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -196,7 +196,8 @@ C will throw an exception. If L 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 option for each attribute to document. --? @@ -204,7 +205,7 @@ B option for each attribute to document. --usage If you have L the C param is also passed to -C. +C as the usage option. =method B @@ -217,6 +218,16 @@ This accessor contains an arrayref of leftover C<@ARGV> elements that L did not parse. Note that the real C<@ARGV> is left un-mangled. +=method B + +This accessor contains the L object (if +L is used). + +=method B + +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 This returns the role meta object. diff --git a/lib/MooseX/Getopt/Basic.pm b/lib/MooseX/Getopt/Basic.pm index 9ef96ba..9a6c79a 100644 --- a/lib/MooseX/Getopt/Basic.pm +++ b/lib/MooseX/Getopt/Basic.pm @@ -63,7 +63,7 @@ sub new_with_options { 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}); } @@ -71,6 +71,7 @@ sub new_with_options { $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 ); diff --git a/lib/MooseX/Getopt/GLD.pm b/lib/MooseX/Getopt/GLD.pm index b2ccafe..5edb937 100644 --- a/lib/MooseX/Getopt/GLD.pm +++ b/lib/MooseX/Getopt/GLD.pm @@ -7,6 +7,20 @@ use Getopt::Long::Descriptive 0.081; 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(@_); diff --git a/t/104_override_usage.t b/t/104_override_usage.t index 173c632..d3d0868 100644 --- a/t/104_override_usage.t +++ b/t/104_override_usage.t @@ -10,7 +10,6 @@ use Test::Exception; 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++; }; @@ -44,9 +43,9 @@ use Test::Exception; 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 } ]; diff --git a/t/107_no_auto_help.t b/t/107_no_auto_help.t index a45ef52..9eab610 100644 --- a/t/107_no_auto_help.t +++ b/t/107_no_auto_help.t @@ -30,11 +30,6 @@ my $fail_on_exit = 1; }, ); - # only here to avoid an "unknown option: help" warning - has help => ( - is => 'ro', isa => 'Bool', - ); - no Moose; 1; } @@ -55,7 +50,8 @@ END { 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$/, diff --git a/t/108_usage_attr.t b/t/108_usage_attr.t new file mode 100644 index 0000000..c0286c5 --- /dev/null +++ b/t/108_usage_attr.t @@ -0,0 +1,35 @@ +#!/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'); + diff --git a/t/109_help_flag.t b/t/109_help_flag.t new file mode 100644 index 0000000..c60c272 --- /dev/null +++ b/t/109_help_flag.t @@ -0,0 +1,51 @@ +#!/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'); +