From: Dagfinn Ilmari Mannsåker Date: Thu, 9 Apr 2009 15:56:19 +0000 (+0100) Subject: add MooseX::Getopt::Dashes X-Git-Tag: 0_18~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f78e8817a86a1178b4880d40da6cc2027c78a7a;p=gitmo%2FMooseX-Getopt.git add MooseX::Getopt::Dashes --- diff --git a/ChangeLog b/ChangeLog index 46ad596..4fcb7e2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,12 @@ Revision history for Perl extension MooseX-Getopt +0.18 Thu. April 9 2009 + * MooseX::Getopt::Dashes + - New module, for converting undercores to dashes + + * t/ + - Tests for MooseX::Getopt::Dashes + 0.17 Wed. April 8 2009 * MooseX::Getopt - work with latest Moose (hdp) diff --git a/lib/MooseX/Getopt/Dashes.pm b/lib/MooseX/Getopt/Dashes.pm new file mode 100644 index 0000000..ffad599 --- /dev/null +++ b/lib/MooseX/Getopt/Dashes.pm @@ -0,0 +1,64 @@ +package MooseX::Getopt::Dashes; +use Moose::Role; + +with 'MooseX::Getopt'; + +around _get_cmd_flags_for_attr => sub { + my $next = shift; + my ( $class, $attr, @rest ) = @_; + + my ( $flag, @aliases ) = $class->$next($attr, @rest); + $flag =~ tr/_/-/ + unless $attr->does('MooseX::Getopt::Meta::Attribute::Trait') + && $attr->has_cmd_flag; + + return ( $flag, @aliases ); +}; + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Getopt::Dashes - convert underscores in attribute names to dashes + +=head1 DESCRIPTION + +This is a version of C which converts underscores in +attribute names to dashes when generating command line flags. + +=head1 METHODS + +=over 4 + +=item meta + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Dagfinn Ilmari MannsEker Eilmari@ilmari.orgE + +Stevan Little Estevan@iinteractive.comE + +Yuval Kogman C<< >> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/010_dashes.t b/t/010_dashes.t new file mode 100644 index 0000000..4ec1248 --- /dev/null +++ b/t/010_dashes.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 3; + +use Test::Exception; + + +BEGIN { + use_ok('MooseX::Getopt'); +} + +{ + package App; + use Moose; + + with 'MooseX::Getopt::Dashes'; + + has 'some_thingy' => ( is => 'ro', isa => 'Str', default => 'foo' ); +} + +{ + local @ARGV = (qw/--some-thingy bar/); + lives_and { is( App->new_with_options->some_thingy, 'bar') } 'Dash in option name'; +} + +{ + local @ARGV = (qw/--some_thingy bar/); + throws_ok { App->new_with_options } qr/Unknown option: some_thingy/; +}