X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt%2FOptionTypeMap.pm;h=3ec28327b933732c1294c80c2186b5508e366c12;hb=e4ab19b9445dcf65ee157b92616946863ee7274b;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..3ec2832 100644
--- a/lib/MooseX/Getopt/OptionTypeMap.pm
+++ b/lib/MooseX/Getopt/OptionTypeMap.pm
@@ -1,29 +1,71 @@
 
 package MooseX::Getopt::OptionTypeMap;
 
-use Moose 'confess';
+use Moose 'confess', 'blessed';
 use Moose::Util::TypeConstraints 'find_type_constraint';
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
 my %option_type_map = (
     'Bool'     => '!',
     'Str'      => '=s',
     'Int'      => '=i',
-    'Float'    => '=f',
+    'Num'      => '=f',
     'ArrayRef' => '=s@',
     '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_or_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_or_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_or_name) = @_;
+
+    my $name = blessed($type_or_name) ? $type_or_name->name : $type_or_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_or_name'";    
+
+    while ( $current = $current->parent ) {
+        return $option_type_map{$current->name}
+            if exists $option_type_map{$current->name};
+    }
+
+    return;
+}
+
 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;
 }
 
@@ -49,12 +91,14 @@ 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)>
 
+=item B<meta>
+
 =back
 
 =head1 BUGS
@@ -69,11 +113,11 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>
 
 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