From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 26 Jul 2008 05:08:54 +0000 (+0000)
Subject: also accept type constraint objects in option type map (fixes autovivified type const... 
X-Git-Tag: 0_15~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=365e57846d449e166830f6002b1fee437a5bd95d;p=gitmo%2FMooseX-Getopt.git

also accept type constraint objects in option type map (fixes autovivified type constraints
---

diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm
index 85747e5..b96edfb 100644
--- a/lib/MooseX/Getopt.pm
+++ b/lib/MooseX/Getopt.pm
@@ -194,9 +194,9 @@ sub _attrs_to_options {
         my $opt_string = join(q{|}, $flag, @aliases);
 
         if ($attr->has_type_constraint) {
-            my $type_name = $attr->type_constraint->name;
-            if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
-                $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name)
+            my $type = $attr->type_constraint;
+            if (MooseX::Getopt::OptionTypeMap->has_option_type($type)) {
+                $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
             }
         }
 
diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm
index c9e1e05..188365c 100644
--- 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)>