From: Karen Etheridge <ether@cpan.org>
Date: Thu, 27 Dec 2012 08:20:46 +0000 (-0800)
Subject: chain _getopt_full_usage in the other direction, to unbreak modules that override... 
X-Git-Tag: v0.50~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b150707212285aa9a67390a15ececeb9ef204cdd;p=gitmo%2FMooseX-Getopt.git

chain _getopt_full_usage in the other direction, to unbreak modules that override this
---

diff --git a/Changes b/Changes
index 251dff1..7d4bccc 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 Revision history for Perl extension MooseX-Getopt
 
 {{$NEXT}}
+ - unbreak Catalyst::Runtime tests (etc) by keeping _getopt_full_usage in the
+   callstack. (RT#82249)
 
 0.49      2012-12-26 10:13:41 PST-0800
  - silence a warning in tests if the user does not have YAML::XS installed
diff --git a/lib/MooseX/Getopt/Basic.pm b/lib/MooseX/Getopt/Basic.pm
index f0b06bc..240f683 100644
--- a/lib/MooseX/Getopt/Basic.pm
+++ b/lib/MooseX/Getopt/Basic.pm
@@ -152,17 +152,18 @@ sub _getopt_spec_exception {
     die @$warnings, $exception;
 }
 
-#(this is already documented in MooseX::Getopt. But FIXME later, via RT#82195)
-=for Pod::Coverage
-    print_usage_text
-=cut
-sub print_usage_text {
+# maintained for backwards compatibility only
+sub _getopt_full_usage
+{
     my ($self, $usage) = @_;
     print $usage->text;
     exit 0;
 }
-# maintained for backwards compatibility only
-sub _getopt_full_usage { shift->print_usage_text(@_) }
+#(this is already documented in MooseX::Getopt. But FIXME later, via RT#82195)
+=for Pod::Coverage
+    print_usage_text
+=cut
+sub print_usage_text { shift->_getopt_full_usage(@_) }
 
 sub _usage_format {
     return "usage: %c %o";
diff --git a/t/104_override_usage.t b/t/104_override_usage.t
index 517d8aa..8fa9299 100644
--- a/t/104_override_usage.t
+++ b/t/104_override_usage.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 7;
 use Test::Trap;
 use Test::NoWarnings 1.04 ':early';
 
@@ -56,3 +56,30 @@ USAGE
     );
 }
 
+{
+    package MyScript2;
+    use Moose;
+
+    with 'MooseX::Getopt';
+    has foo => ( isa => 'Int', is => 'ro', documentation => 'A foo' );
+}
+
+{
+    # some classes (e.g. ether's darkpan and Catalyst::Runtime) overrode
+    # _getopt_full_usage, so we need to keep it in the call stack so we don't
+    # break them.
+    Class::MOP::class_of('MyScript2')->add_before_method_modifier(
+        _getopt_full_usage => sub {
+            print "--- DOCUMENTATION ---\n";
+        },
+    );
+
+    local @ARGV = ('--help');
+    trap { MyScript2->new_with_options };
+    is(
+        $trap->stdout,
+        join("\n", '--- DOCUMENTATION ---', $usage),
+        'additional text included before normal usage string',
+    );
+}
+