From: Piotr Roszatycki <piotr.roszatycki@gmail.com>
Date: Thu, 27 Nov 2008 17:49:00 +0000 (+0000)
Subject: * Handle hyphen punctuation mark in cmd_flag and cmd_aliases.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ec05c565a78b01ab0b7de5a59f21b8e3b7a26d60;p=gitmo%2FMooseX-Getopt.git

* Handle hyphen punctuation mark in cmd_flag and cmd_aliases.
---

diff --git a/lib/MooseX/Getopt/Parser/Descriptive.pm b/lib/MooseX/Getopt/Parser/Descriptive.pm
index bc4bf57..44035f1 100644
--- a/lib/MooseX/Getopt/Parser/Descriptive.pm
+++ b/lib/MooseX/Getopt/Parser/Descriptive.pm
@@ -52,11 +52,13 @@ sub build_options {
         my ($flag, @aliases) = $getopt->_get_cmd_flags_for_attr($attr);
         my $type = $getopt->_get_cmd_type_for_attr($attr);
 
-        $cmd_flags_to_names{$flag} = $name;
-
         my $opt_string = join '|', $flag, @aliases;
         $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type) if $type;
 
+        # opt_string is unmangled; parsed options key is mangled
+        $flag =~ tr/-/_/;
+        $cmd_flags_to_names{$flag} = $name;
+
         my $doc;
         $doc = $attr->documentation if $attr->has_documentation;
         $doc = ' ' unless $doc;
diff --git a/t/006_metaclass_traits.t b/t/006_metaclass_traits.t
index 7e5eba5..2dab270 100644
--- a/t/006_metaclass_traits.t
+++ b/t/006_metaclass_traits.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 251;
+use Test::More tests => 291;
 use Test::Moose;
 
 BEGIN {
@@ -41,6 +41,15 @@ BEGIN {
         cmd_aliases => 'x',
     );
 
+    has 'guinea_pig' => (
+        traits      => [ 'Getopt' ],
+        is          => 'ro',
+        isa         => 'Str',
+        default     => 'squeak',
+        cmd_flag    => 'guinea-pig',
+        cmd_aliases => [qw/ cavia-porcellus /],
+    );
+
     has 'length' => (
         is      => 'ro',
         isa     => 'Int',
@@ -80,7 +89,7 @@ BEGIN {
 
 }
 
-foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) {
+foreach my $attr_name (qw(data cow horse guinea_pig _private_stuff_cmdline)) {
     my $attr = App->meta->get_attribute($attr_name);
     isa_ok($attr, 'Moose::Meta::Attribute');
     does_ok($attr, 'MooseX::Getopt::Meta::Attribute::Trait');
@@ -93,7 +102,7 @@ foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser:
     SKIP: {
         if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
             eval { require Getopt::Long::Descriptive };
-            skip "Getopt::Long::Descriptive not installed", 78 if $@;
+            skip "Getopt::Long::Descriptive not installed", 90 if $@;
         }
 
         {
@@ -284,6 +293,47 @@ foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser:
             is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
         }
 
+        # Test cmd_alias + cmd_flag with hyphen
+        {
+            local @ARGV = ();
+
+            my $parser = $parser_name->new;
+            ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
+
+            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
+            isa_ok($getopt, 'MooseX::Getopt::Session');
+
+            my $app = App->new_with_options( getopt => $getopt );
+            isa_ok($app, 'App');
+            is($app->guinea_pig, 'squeak', 'cmd_alias+cmd_flag with hyphen, using default');
+        }
+        {
+            local @ARGV = ('guinea-pig', 'babe');
+
+            my $parser = $parser_name->new;
+            ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
+
+            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
+            isa_ok($getopt, 'MooseX::Getopt::Session');
+
+            my $app = App->new_with_options( getopt => $getopt );
+            isa_ok($app, 'App');
+            is($app->guinea_pig, 'squeak', 'cmd_alias+cmd_flag with hyphen, using flag');
+        }
+        {
+            local @ARGV = ('--cavia-porcellus', 'babe');
+
+            my $parser = $parser_name->new;
+            ok(ref($parser) =~ /^MooseX::Getopt::Parser::/, '... parser object is created');
+
+            my $getopt = MooseX::Getopt::Session->new( parser => $parser );
+            isa_ok($getopt, 'MooseX::Getopt::Session');
+
+            my $app = App->new_with_options( getopt => $getopt );
+            isa_ok($app, 'App');
+            is($app->guinea_pig, 'babe', 'cmd_alias+cmd_flag with hyphen, using alias');
+        }
+
         # Test _foo + cmd_flag
         {
             local @ARGV = ('-p', '666');