X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt%2FOptionTypeMap.pm;h=56d69aa05ef3b5fa16155f3266e791cd86be5a3f;hb=8b9e50c33133b5735d32f4b3d05eee82a919b382;hp=c9e1e055802acae934836f3bbd2ee27e4d94c2d9;hpb=d64acebb45741238355b2fb396dfaa30d1af393a;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm index c9e1e05..56d69aa 100644 --- a/lib/MooseX/Getopt/OptionTypeMap.pm +++ b/lib/MooseX/Getopt/OptionTypeMap.pm @@ -1,10 +1,10 @@ package MooseX::Getopt::OptionTypeMap; -use Moose 'confess'; +use Moose 'confess', 'blessed'; use Moose::Util::TypeConstraints 'find_type_constraint'; -our $VERSION = '0.03'; +our $VERSION = '0.26'; our $AUTHORITY = 'cpan:STEVAN'; my %option_type_map = ( @@ -17,13 +17,14 @@ my %option_type_map = ( ); sub has_option_type { - my (undef, $type_name) = @_; - return 1 if exists $option_type_map{$type_name}; + my (undef, $type_or_name) = @_; - my $current = find_type_constraint($type_name); + 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); (defined $current) - || confess "Could not find the type constraint for '$type_name'"; + || confess "Could not find the type constraint for '$type_or_name'"; while (my $parent = $current->parent) { return 1 if exists $option_type_map{$parent->name}; @@ -34,20 +35,20 @@ sub has_option_type { } sub get_option_type { - my (undef, $type_name) = @_; - - return $option_type_map{$type_name} - if exists $option_type_map{$type_name}; + my (undef, $type_or_name) = @_; + + my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_name; - my $current = find_type_constraint($type_name); + return $option_type_map{$name} if exists $option_type_map{$name}; + + my $current = ref $type_or_name ? $type_or_name : find_type_constraint($type_or_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; + || confess "Could not find the type constraint for '$type_or_name'"; + + while ( $current = $current->parent ) { + return $option_type_map{$current->name} + if exists $option_type_map{$current->name}; } return; @@ -57,8 +58,14 @@ sub add_option_type_to_map { my (undef, $type_name, $option_string) = @_; (defined $type_name && defined $option_string) || confess "You must supply both a type name and an option string"; - (find_type_constraint($type_name)) - || confess "The type constraint '$type_name' does not exist"; + + if ( blessed($type_name) ) { + $type_name = $type_name->name; + } else { + (find_type_constraint($type_name)) + || confess "The type constraint '$type_name' does not exist"; + } + $option_type_map{$type_name} = $option_string; } @@ -84,9 +91,9 @@ These are all class methods and should be called as such. =over 4 -=item B +=item B -=item B +=item B =item B