From: Brandon L Black 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?a=commitdiff_plain;h=de75868f0e8c3865b3f207b7ea84920760a6c8d3;p=gitmo%2FMooseX-Getopt.git 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. =item B +Changes the commandline flag to be this value, instead of the default, +which is the same as the attribute name. + +=item B + +Adds more aliases for this commandline flag, useful for short options +and such. + =item B +=item B + =item B =back @@ -85,4 +105,4 @@ L 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'); +}