r23603 - in /branches/upstream/libmoosex-getopt-perl/current: ChangeLog META.yml lib/MooseX/Getopt.pm lib/MooseX/Getopt/OptionTypeMap.pm

[gregoa at users.alioth.debian.org]

Author: gregoa
Date: Sat Jul 26 16:21:04 2008
New Revision: 23603

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=23603
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-getopt-perl (0.15)

Modified:
    branches/upstream/libmoosex-getopt-perl/current/ChangeLog
    branches/upstream/libmoosex-getopt-perl/current/META.yml
    branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm
    branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm

Modified: branches/upstream/libmoosex-getopt-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-getopt-perl/current/ChangeLog?rev=23603&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/ChangeLog (original)
+++ branches/upstream/libmoosex-getopt-perl/current/ChangeLog Sat Jul 26 16:21:04 2008
@@ -1,4 +1,8 @@
 Revision history for Perl extension MooseX-Getopt
+
+0.15 Sat. July 26 2008
+	* MooseX::Getopt::OptionTypeMap
+	  - Accept type constraint objects in the type mapping, not just names
 
 0.14 Thurs. July 10, 2008
 	* MooseX::Getopt::OptionTypeMap

Modified: branches/upstream/libmoosex-getopt-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-getopt-perl/current/META.yml?rev=23603&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-getopt-perl/current/META.yml Sat Jul 26 16:21:04 2008
@@ -20,4 +20,4 @@
   Getopt::Long: 2.37
   Getopt::Long::Descriptive: 0
   Moose: 0.43
-version: 0.14
+version: 0.15

Modified: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm?rev=23603&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm (original)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt.pm Sat Jul 26 16:21:04 2008
@@ -11,7 +11,7 @@
 use Getopt::Long (); # GLD uses it anyway, doesn't hurt
 use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive };
 
-our $VERSION   = '0.14';
+our $VERSION   = '0.15';
 our $AUTHORITY = 'cpan:STEVAN';
 
 has ARGV       => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
@@ -194,9 +194,9 @@
         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)
             }
         }
 

Modified: branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm?rev=23603&op=diff
==============================================================================
--- branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm (original)
+++ branches/upstream/libmoosex-getopt-perl/current/lib/MooseX/Getopt/OptionTypeMap.pm Sat Jul 26 16:21:04 2008
@@ -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.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
 my %option_type_map = (
@@ -17,13 +17,14 @@
 );
 
 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 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 $current = find_type_constraint($type_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_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 @@
     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 @@
 
 =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)>