X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt%2FOptionTypeMap.pm;h=3d94c785e7b27785ce9ac49ccc73d7cd3cdb39ee;hb=edfb736cb47388616f04aef731cb0cd047bcaa91;hp=a443d9d865e77b8a216839cc1385e20e830f943b;hpb=8034a2324bcef31b91a45a83baec1508acee2763;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm index a443d9d..3d94c78 100644 --- a/lib/MooseX/Getopt/OptionTypeMap.pm +++ b/lib/MooseX/Getopt/OptionTypeMap.pm @@ -4,7 +4,7 @@ package MooseX::Getopt::OptionTypeMap; use Moose 'confess'; use Moose::Util::TypeConstraints 'find_type_constraint'; -our $VERSION = '0.01'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; my %option_type_map = ( @@ -16,8 +16,43 @@ my %option_type_map = ( 'HashRef' => '=s%', ); -sub has_option_type { exists $option_type_map{$_[1]} } -sub get_option_type { $option_type_map{$_[1]} } +sub has_option_type { + my (undef, $type_name) = @_; + return 1 if exists $option_type_map{$type_name}; + + my $current = find_type_constraint($type_name); + + (defined $current) + || confess "Could not find the type constraint for '$type_name'"; + + while (my $parent = $current->parent) { + return 1 if exists $option_type_map{$parent->name}; + $current = $parent; + } + + return 0; +} + +sub get_option_type { + my (undef, $type_name) = @_; + + return $option_type_map{$type_name} + if exists $option_type_map{$type_name}; + + my $current = find_type_constraint($type_name); + + (defined $current) + || confess "Could not find the type constraint for '$type_name'"; + + while (my $parent = $current->parent) { + return $option_type_map{$parent->name} + if exists $option_type_map{$parent->name}; + $current = $parent; + } + + return; +} + sub add_option_type_to_map { my (undef, $type_name, $option_string) = @_; (defined $type_name && defined $option_string) @@ -55,6 +90,8 @@ These are all class methods and should be called as such. =item B +=item B + =back =head1 BUGS @@ -76,4 +113,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