From: Karen Etheridge Date: Sun, 27 Jun 2010 05:12:37 +0000 (-0700) Subject: Disable auto_help config in Getopt::Long, to avoid calling into pod2usage when the... X-Git-Tag: 0.30~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8e026f54bc564a771c0bb59915175bcd9de9219e;p=gitmo%2FMooseX-Getopt.git Disable auto_help config in Getopt::Long, to avoid calling into pod2usage when the --help option is used (the intent is just to fetch the value of the configfile option). (RT#57683) --- diff --git a/t/no_auto_help.t b/t/no_auto_help.t new file mode 100644 index 0000000..1afeffb --- /dev/null +++ b/t/no_auto_help.t @@ -0,0 +1,54 @@ +# Related information: +# https://rt.cpan.org/Public/Bug/Display.html?id=47865 +# https://rt.cpan.org/Public/Bug/Display.html?id=52474 +# https://rt.cpan.org/Public/Bug/Display.html?id=57683 +# http://www.nntp.perl.org/group/perl.moose/2010/06/msg1767.html + +# Summary: If we disable the "auto_help" option in Getopt::Long, then +# getoptions() will not call into pod2usage() (causing program termination) +# when --help is passed. + + +my $fail_on_exit = 1; +{ + package Class; + use strict; use warnings; + + use Moose; + with + 'MooseX::SimpleConfig', + 'MooseX::Getopt'; + + # this is a hacky way of being able to check that we made it past the + # $opt_parser->getoptions() call in new_with_options, because it is + # still going to bail out later on, on seeing the --help flag + has configfile => ( + is => 'ro', isa => 'Str', + default => sub { + $fail_on_exit = 0; + 'this_value_unimportant', + }, + ); + + # only here to avoid an "unknown option: help" warning + has help => ( + is => 'ro', isa => 'Bool', + ); + + no Moose; + 1; +} + +use Test::More tests => 1; + +END { + ok(!$fail_on_exit, 'getoptions() lives'); + + # cancel the non-zero exit status from _getopt_full_usage() + exit 0; +} + + +@ARGV = ('--help'); +Class->new_with_options; +