Skip Menu |

This queue is for tickets about the MooseX-Getopt CPAN distribution.

Report information
The Basics
Id: 58417
Status: resolved
Priority: 0/
Queue: MooseX-Getopt

People
Owner: bobtfish [...] bobtfish.net
Requestors: MAROS [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.28
Fixed in: (no value)



Subject: Handling of type unions
MooseX::Getopt does not handle type unions correctly. See attached test case. Cheers Maroš
Subject: fail.t
#!/usr/bin/perl use strict; use warnings; use Test::Most tests => 4; { package example; use Moose; use Moose::Util::TypeConstraints; with qw( MooseX::Getopt ); subtype 'ResultSet' => as 'DBIx::Class::ResultSet'; subtype 'ResultList' => as 'ArrayRef[Int]'; # has no influence on test result # MooseX::Getopt::OptionTypeMap->add_option_type_to_map( # 'ResultList' => '=s', # ); coerce 'ResultList' => from 'Str' => via { return [ grep { m/^\d+$/ } split /\D/,$_ ]; # <- split string into arrayref }; has 'results' => ( is => 'rw', isa => 'ResultList | ResultSet', # <- union constraint coerce => 1, ); } # Without MooseX::Getopt { my $example = example->new({ results => '1234,5678,9012', }); isa_ok($example, 'example'); explain($example->results); cmp_deeply($example->results, [qw(1234 5678 9012)], 'result as expected'); } # With MooseX::Getopt { local @ARGV = ('--results','1234,5678,9012'); my $example = example->new_with_options; isa_ok($example, 'example'); explain($example->results); cmp_deeply($example->results, [qw(1234 5678 9012)], 'result as expected'); }
Attached a patch that should fix this issue Cheers Maroš
Subject: 0002-Fix-bug-when-handling-union-types.patch
diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm index 15c479f..4102c75 100644 --- a/lib/MooseX/Getopt/OptionTypeMap.pm +++ b/lib/MooseX/Getopt/OptionTypeMap.pm @@ -16,6 +16,15 @@ my %option_type_map = ( sub has_option_type { my (undef, $type_or_name) = @_; + if (blessed($type_or_name) + && $type_or_name->isa('Moose::Meta::TypeConstraint::Union')) { + foreach my $union_type (@{$type_or_name->type_constraints}) { + return 1 + if __PACKAGE__->has_option_type($union_type); + } + return 0; + } + return 1 if exists $option_type_map{blessed($type_or_name) ? $type_or_name->name : $type_or_name}; my $current = blessed($type_or_name) ? $type_or_name : find_type_constraint($type_or_name); @@ -34,6 +43,16 @@ sub has_option_type { sub get_option_type { my (undef, $type_or_name) = @_; + if (blessed($type_or_name) + && $type_or_name->isa('Moose::Meta::TypeConstraint::Union')) { + foreach my $union_type (@{$type_or_name->type_constraints}) { + my $option_type = __PACKAGE__->get_option_type($union_type); + return $option_type + if defined $option_type; + } + return; + } + my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name; return $option_type_map{$name} if exists $option_type_map{$name}; diff --git a/t/107_union_bug.t b/t/107_union_bug.t new file mode 100644 index 0000000..f3283c7 --- /dev/null +++ b/t/107_union_bug.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::Most tests => 5; + +{ + package example; + + use Moose; + use Moose::Util::TypeConstraints; + with qw( + MooseX::Getopt + ); + + subtype 'ResultSet' + => as 'DBIx::Class::ResultSet'; + + subtype 'ResultList' + => as 'ArrayRef[Int]'; + + MooseX::Getopt::OptionTypeMap->add_option_type_to_map( + 'ResultList' => '=s', + ); + + coerce 'ResultList' + => from 'Str' + => via { + return [ grep { m/^\d+$/ } split /\D/,$_ ]; # <- split string into arrayref + }; + + has 'results' => ( + is => 'rw', + isa => 'ResultList | ResultSet', # <- union constraint + coerce => 1, + ); + + has 'other' => ( + is => 'rw', + isa => 'Str', + ); +} + +# Without MooseX::Getopt +{ + my $example = example->new({ + results => '1234,5678,9012', + other => 'test', + }); + isa_ok($example, 'example'); + explain($example->results); + cmp_deeply($example->results, [qw(1234 5678 9012)], 'result as expected'); +} + +# With MooseX::Getopt +{ + local @ARGV = ('--results','1234,5678,9012','--other','test'); + my $example = example->new_with_options; + isa_ok($example, 'example'); + + explain($example->results); + is($example->other,'test'); + cmp_deeply($example->results, [qw(1234 5678 9012)], 'result as expected'); +} \ No newline at end of file
Hi, i'd be very happy if you could apply my patch any time soon (or give me some feedback if you do not accept my solution). It is quite a nuisance having to apply this patch on all our live systems. Cheers Maroš Am Sa 19. Jun 2010, 02:07:16, MAROS schrieb: Show quoted text
> Attached a patch that should fix this issue > > Cheers > Maroš
Sorry for the delay, I've applied your patch as 416dcb2, will be in the next release shortly.