From: John Napiorkowski <jjnapiork@cpan.org>
Date: Tue, 26 Aug 2008 21:35:39 +0000 (+0000)
Subject: better handling of method arg validation, more docs and internal questions (hoping... 
X-Git-Tag: 0.06~4^2~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e088dd0352e963c94da8202d73abd3a68b6f2486;hp=cf1a8bfa50cb6cab796582ddae0a5b05dfcd8759;p=gitmo%2FMooseX-Types.git

better handling of method arg validation, more docs and internal questions (hoping mst looks carefully) added a test case from IRC
---

diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index 1f40b7e..f1d3a66 100644
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -304,13 +304,23 @@ sub type_export_generator {
     my ($class, $type, $name) = @_;
     return sub {
         my $type_constraint;
-        if(my $params = shift @_) {
-            $type_constraint = $class->create_arged_type_constraint($name, @$params);
+        if(defined(my $params = shift @_)) {
+            if(ref $params eq 'ARRAY') {
+                $type_constraint = $class->create_arged_type_constraint($name, @$params);
+            } else {
+                croak 'Arguments must be an ArrayRef, not '. ref $params;
+            }
         } else {
-            $type_constraint = $class->create_base_type_constraint($name)
-             || MooseX::Types::UndefinedType->new($name);           
+            $type_constraint = $class->create_base_type_constraint($name);
+        }
+        $type_constraint = defined($type_constraint) ? $type_constraint
+         : MooseX::Types::UndefinedType->new($name);
+         
+        if(my(@extra_args) = @_) {
+            return $class->create_type_decorator($type_constraint), @_;
+        } else {
+            return $class->create_type_decorator($type_constraint);
         }
-        return $class->create_type_decorator($type_constraint);
     };
 }
 
diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index b73ccf3..99cfeda 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -10,7 +10,8 @@ use overload(
     },
     '|' => sub {
         my @names = grep {$_} map {"$_"} @_;
-        ## Don't know why I can't use the array version of this...
+        ## Don't know why I can't use the array version of this...  If someone
+        ## knows would like to hear from you.
         my $names = join('|', @names);
         Moose::Util::TypeConstraints::create_type_constraint_union($names);
     },
@@ -42,13 +43,13 @@ sub new {
 
 =head type_constraint ($type_constraint)
 
-Set/Get the type_constraint
+Set/Get the type_constraint.
 
 =cut
 
 sub type_constraint {
     my $self = shift @_;
-    if(my $tc = shift @_) {
+    if(defined(my $tc = shift @_)) {
         $self->{type_constraint} = $tc;
     }
     return $self->{type_constraint};
@@ -70,8 +71,7 @@ Delegate to the decorator targe
 
 =cut
 
-sub AUTOLOAD
-{
+sub AUTOLOAD {
     my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
     return shift->type_constraint->$method(@_);
 }
diff --git a/t/13_typedecorator.t b/t/13_typedecorator.t
index 585dce2..4bd5960 100644
--- a/t/13_typedecorator.t
+++ b/t/13_typedecorator.t
@@ -2,7 +2,7 @@
 use warnings;
 use strict;
 
-use Test::More tests => 29;
+use Test::More tests => 33;
 use Test::Exception;
 use FindBin;
 use lib "$FindBin::Bin/lib";
@@ -16,6 +16,7 @@ use lib "$FindBin::Bin/lib";
     );
     use DecoratorLibrary qw(
         MyArrayRefBase MyArrayRefInt01 MyArrayRefInt02 StrOrArrayRef
+        AtLeastOneInt
     );
     
     has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
@@ -23,6 +24,7 @@ use lib "$FindBin::Bin/lib";
     has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1);
     has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]);
     has 'StrOrArrayRef' => (is=>'rw', isa=>StrOrArrayRef);
+    has 'AtLeastOneInt' => (is=>'rw', isa=>AtLeastOneInt);
 }
 
 ## Make sure we have a 'create object sanity check'
@@ -125,4 +127,21 @@ ok $type->StrOrArrayRef([1,2,3])
  
 throws_ok sub {
     $type->StrOrArrayRef({a=>111});
-}, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
\ No newline at end of file
+}, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref';
+
+# Test AtLeastOneInt
+
+ok $type->AtLeastOneInt([1,2]),
+ => 'Good assignment';
+
+is_deeply $type->AtLeastOneInt, [1,2]
+ => "Got expected values.";
+ 
+throws_ok sub {
+    $type->AtLeastOneInt([]);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails';
+
+throws_ok sub {
+    $type->AtLeastOneInt(['a','b']);
+}, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails arrayref of strings';
+
diff --git a/t/lib/DecoratorLibrary.pm b/t/lib/DecoratorLibrary.pm
index c99c189..6ded368 100644
--- a/t/lib/DecoratorLibrary.pm
+++ b/t/lib/DecoratorLibrary.pm
@@ -12,6 +12,7 @@ use MooseX::Types
         MyHashRefOfInts
         MyHashRefOfStr
         StrOrArrayRef
+        AtLeastOneInt
     )];
 
 subtype MyArrayRefBase,
@@ -46,10 +47,18 @@ coerce MyArrayRefInt02,
     via {[sort values(%$_)]},
     from MyHashRefOfStr,
     via {[ sort map { length $_ } values(%$_) ]},
-    ### Can't do HashRef[ArrayRef] here, need to force precidence I guess???
+    ## Can't do HashRef[ArrayRef] here since if I do HashRef get the via {}
+    ## Stuff passed as args.  
     from HashRef([ArrayRef]),
-    via {[ sort map { @$_ } values(%$_)] };
+    via {[ sort map { @$_ } values(%$_) ]};
 
 subtype StrOrArrayRef,
-    from Str|ArrayRef;
+    as Str|ArrayRef;
+    
+subtype AtLeastOneInt,
+    ## Same problem as MyArrayRefInt02, see above.  Another way to solve it by
+    ## forcing some sort of context.  Tried to fix this with method prototypes
+    ## but just couldn't make it work.
+    as (ArrayRef[Int]),
+    where { @$_ > 0 };
 1;