also accept type constraint objects in option type map (fixes autovivified type const...

[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt / OptionTypeMap.pm

diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm
index c9e1e05..188365c 100644 (file)
--- a/lib/MooseX/Getopt/OptionTypeMap.pm
+++ b/lib/MooseX/Getopt/OptionTypeMap.pm
@@ -1,7 +1,7 @@
 
 package MooseX::Getopt::OptionTypeMap;
 
-use Moose 'confess';
+use Moose 'confess', 'blessed';
 use Moose::Util::TypeConstraints 'find_type_constraint';
 
 our $VERSION   = '0.03';
@@ -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<has_option_type ($type_name)>
+=item B<has_option_type ($type_or_name)>
 
-=item B<get_option_type ($type_name)>
+=item B<get_option_type ($type_or_name)>
 
 =item B<add_option_type_to_map ($type_name, $option_spec)>