* Perltidy.

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

diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm
index 3d94c78..449510c 100644 (file)
--- a/lib/MooseX/Getopt/OptionTypeMap.pm
+++ b/lib/MooseX/Getopt/OptionTypeMap.pm
@@ -1,71 +1,97 @@
 
 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.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
+
 my %option_type_map = (
-    'Bool'     => '!',
-    'Str'      => '=s',
-    'Int'      => '=i',
-    'Float'    => '=f',
-    'ArrayRef' => '=s@',
-    'HashRef'  => '=s%',    
+    'Bool'            => '!',
+    'Str'             => '=s',
+    'Int'             => '=i',
+    'Num'             => '=f',
+    'ArrayRef'        => '=s@',
+    'HashRef'         => '=s%',
+    'Bool|Str'        => ':s',
+    'Bool|Int'        => ':i',
+    'Bool|Num'        => ':f',
+    'Str|Bool'        => ':s',
+    'Int|Bool'        => ':i',
+    'Num|Bool'        => ':f',
 );
 
+
 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};
+    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);
+
+    Moose->throw_error("Could not find the type constraint for '$type_or_name'")
+        unless defined $current;
+
+    while ( my $parent = $current->parent ) {
+        return 1 if exists $option_type_map{ $parent->name };
         $current = $parent;
-    }
+    };
+
+    return '';
+};
 
-    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;
-    }
+    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);
+
+    Moose->throw_error("Could not find the type constraint for '$type_or_name'")
+        unless defined $current;
+
+    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";
+
+    Moose->throw_error("You must supply both a type name and an option string")
+        unless defined $type_name && defined $option_string;
+
+    if (blessed $type_name) {
+        $type_name = $type_name->name;
+    }
+    else {
+        Moose->throw_error("The type constraint '$type_name' does not exist")
+            unless find_type_constraint($type_name);
+    };
+
     $option_type_map{$type_name} = $option_string;
-}
+};
+
 
 no Moose; no Moose::Util::TypeConstraints; 1;
 
-__END__
 
+__END__
 
 =pod
 
@@ -84,9 +110,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)>
 
@@ -96,7 +122,7 @@ These are all class methods and should be called as such.
 
 =head1 BUGS
 
-All complex software has bugs lurking in it, and this module is no 
+All complex software has bugs lurking in it, and this module is no
 exception. If you find a bug please either email me, or add the bug
 to cpan-RT.
 
@@ -106,7 +132,7 @@ 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>