From: Brandon L Black <blblack@gmail.com>
Date: Mon, 2 Apr 2007 20:16:45 +0000 (+0000)
Subject: added cmd_alias to accomplish "verbose|debug|v|d" sort of stuff
X-Git-Tag: 0_02~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Getopt.git;a=commitdiff_plain;h=de75868f0e8c3865b3f207b7ea84920760a6c8d3

added cmd_alias to accomplish "verbose|debug|v|d" sort of stuff
---

diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm
index e6e07a1..86c5904 100644
--- a/lib/MooseX/Getopt.pm
+++ b/lib/MooseX/Getopt.pm
@@ -16,21 +16,27 @@ sub new_with_options {
     my (@options, %name_to_init_arg);
     foreach my $attr ($class->meta->compute_all_applicable_attributes) {
         my $name = $attr->name;
-        
-        if ($attr->isa('MooseX::Getopt::Meta::Attribute') && $attr->has_cmd_flag) { 
-            $name = $attr->cmd_flag;
+        my $aliases;
+
+        if ($attr->isa('MooseX::Getopt::Meta::Attribute')) {
+            $name = $attr->cmd_flag if $attr->has_cmd_flag;
+            $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases;
         }          
         
         $name_to_init_arg{$name} = $attr->init_arg;        
         
+        my $opt_string = $aliases
+            ? join(q{|}, $name, @$aliases)
+            : $name;
+
         if ($attr->has_type_constraint) {
             my $type_name = $attr->type_constraint->name;
             if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {                   
-                $name .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
+                $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
             }
         }
         
-        push @options => $name;
+        push @options => $opt_string;
     }
 
     my %options;
diff --git a/lib/MooseX/Getopt/Meta/Attribute.pm b/lib/MooseX/Getopt/Meta/Attribute.pm
index ddf928f..634bbbb 100644
--- a/lib/MooseX/Getopt/Meta/Attribute.pm
+++ b/lib/MooseX/Getopt/Meta/Attribute.pm
@@ -13,6 +13,12 @@ has 'cmd_flag' => (
     predicate => 'has_cmd_flag',
 );
 
+has 'cmd_aliases' => (
+    is        => 'rw',
+    isa       => 'ArrayRef',
+    predicate => 'has_cmd_aliases',
+);
+
 no Moose; 1;
 
 __END__
@@ -36,10 +42,14 @@ MooseX::Getopt::Meta::Attribute - Optional meta attribute for custom option name
       is        => 'ro',
       isa       => 'Str',
       default   => 'file.dat',
-      # tells MooseX::Getopt to use -f as the 
+      # tells MooseX::Getopt to use --somedata as the 
       # command line flag instead of the normal 
       # autogenerated one (--data)
-      cmd_flag  => 'f',
+      cmd_flag  => 'somedata',
+      # tells MooseX::Getopt to also allow --moosedata,
+      # -m, and -d as aliases for this same option on
+      # the commandline.
+      cmd_aliases => [qw/ moosedata m d /],
   );
 
 =head1 DESCRIPTION
@@ -60,8 +70,18 @@ within L<MooseX::Getopt>.
 
 =item B<cmd_flag>
 
+Changes the commandline flag to be this value, instead of the default,
+which is the same as the attribute name.
+
+=item B<cmd_aliases>
+
+Adds more aliases for this commandline flag, useful for short options
+and such.
+
 =item B<has_cmd_flag>
 
+=item B<has_cmd_aliases>
+
 =item B<meta>
 
 =back
@@ -85,4 +105,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
-=cut
\ No newline at end of file
+=cut
diff --git a/t/001_basic.t b/t/001_basic.t
index ef74f39..c7eaa36 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 37;
+use Test::More tests => 47;
 
 BEGIN {
     use_ok('MooseX::Getopt');
@@ -23,6 +23,23 @@ BEGIN {
         cmd_flag  => 'f',
     );
 
+    has 'cow' => (
+        metaclass   => 'MooseX::Getopt::Meta::Attribute',        
+        is          => 'ro',
+        isa         => 'Str',
+        default     => 'moo',
+        cmd_aliases => [qw/ moocow m c /],
+    );
+
+    has 'horse' => (
+        metaclass   => 'MooseX::Getopt::Meta::Attribute',        
+        is          => 'ro',
+        isa         => 'Str',
+        default     => 'bray',
+        cmd_flag    => 'horsey',
+        cmd_aliases => ['x'],
+    );
+
     has 'length' => (
         is      => 'ro',
         isa     => 'Int',
@@ -131,5 +148,36 @@ BEGIN {
     is_deeply($app->details, {}, '... details is {} as expected');               
 }
 
+# Test cmd_alias without cmd_flag
+{
+    local @ARGV = ('--cow', '42');
+    my $app = App->new_with_options;
+    isa_ok($app, 'App');
+    is($app->cow, 42, 'cmd_alias, but not using it');
+}
+{
+    local @ARGV = ('--moocow', '88');
+    my $app = App->new_with_options;
+    isa_ok($app, 'App');
+    is($app->cow, 88, 'cmd_alias, using long one');
+}
+{
+    local @ARGV = ('-c', '99');
+    my $app = App->new_with_options;
+    isa_ok($app, 'App');
+    is($app->cow, 99, 'cmd_alias, using short one');
+}
 
-
+# Test cmd_alias + cmd_flag
+{
+    local @ARGV = ('--horsey', '123');
+    my $app = App->new_with_options;
+    isa_ok($app, 'App');
+    is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
+}
+{
+    local @ARGV = ('-x', '321');
+    my $app = App->new_with_options;
+    isa_ok($app, 'App');
+    is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
+}