* MooseX::Getopt::Parser::Descriptive: Getopt::Long::Descriptive::Usage object

[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt / Parser / Descriptive.pm

diff --git a/lib/MooseX/Getopt/Parser/Descriptive.pm b/lib/MooseX/Getopt/Parser/Descriptive.pm
index c60839c..bc4bf57 100644 (file)
--- a/lib/MooseX/Getopt/Parser/Descriptive.pm
+++ b/lib/MooseX/Getopt/Parser/Descriptive.pm
@@ -5,9 +5,10 @@ use Moose;
 
 with 'MooseX::Getopt::Parser';
 
-use Getopt::Long::Descriptive;
 use MooseX::Getopt::OptionTypeMap;
 
+use Getopt::Long::Descriptive ();
+
 
 # Special configuration for parser
 has config => (
@@ -24,6 +25,13 @@ has format => (
     default => 'usage: %c %o',
 );
 
+# Usage object
+has usage => (
+    is => 'rw',
+    isa => 'Maybe[Getopt::Long::Descriptive::Usage]',
+    predicate => 'has_usage',
+);
+
 
 sub build_options {
     my $self = shift;
@@ -32,7 +40,9 @@ sub build_options {
     Moose->throw_error('First argument is not a MooseX::Getopt::Session')
         unless $getopt->isa('MooseX::Getopt::Session');
 
-    my $options = {};
+    my $options = $getopt->options;
+    my $new_options = {};
+
     my $usage;
     my (@opts, %cmd_flags_to_names);
 
@@ -51,7 +61,7 @@ sub build_options {
         $doc = $attr->documentation if $attr->has_documentation;
         $doc = ' ' unless $doc;
 
-        my $is_required = !exists $getopt->params->{$name}
+        my $is_required = !exists $options->{$name}
                           && $attr->is_required
                           && !$attr->has_default
                           && !$attr->has_builder;
@@ -60,7 +70,7 @@ sub build_options {
             $opt_string => $doc,
             {
                 ( $is_required ? ( required => $attr->is_required ) : () ),
-            }
+            },
         ];
     };
 
@@ -75,7 +85,7 @@ sub build_options {
         };
 
         eval {
-            ($options, $usage) = Getopt::Long::Descriptive::describe_options(
+            ($new_options, $usage) = Getopt::Long::Descriptive::describe_options(
                 $self->format, @opts, { getopt_conf => [ $self->config ] }
             );
         };
@@ -86,14 +96,21 @@ sub build_options {
         $getopt->extra_argv( $extra_argv );
     };
 
+    # Store usage object
+    $self->usage( $usage );
+
     # Convert cmd_flags back to names in options hashref
-    $options = { map { $cmd_flags_to_names{$_} => $options->{$_} } keys %$options };
+    $new_options = { map { $cmd_flags_to_names{$_} => $new_options->{$_} } keys %$new_options };
+
+    # Include old options
+    $new_options = { %$options, %$new_options };
 
-    $getopt->options( $options );
+    $getopt->status( ! $warnings );
+    $getopt->options( $new_options );
 
     die $warnings if $warnings;
 
-    return $options;
+    return $new_options;
 };