X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=04c76ccbd44058b7b0fdbe79b4bf0fa3a134d58f;hb=a3319906531cef2b41a87138e75461ced7a3394b;hp=b45ded19a0bbde504d72fa2a38af6a323899a1c6;hpb=e451e85524aea53c921953c31262d9c9b5d0119d;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index b45ded1..04c76cc 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -9,7 +9,7 @@ use List::MoreUtils qw( all any );
 use Scalar::Util qw( blessed reftype );
 use Moose::Exporter;
 
-our $VERSION = '0.73';
+our $VERSION = '0.73_01';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -362,19 +362,20 @@ sub maybe_type {
 }
 
 sub duck_type {
-    my ($type_name, @methods) = @_;
+    my ( $type_name, @methods ) = @_;
     if ( ref $type_name eq 'ARRAY' && !@methods ) {
-        @methods    = @$type_name;
+        @methods   = @$type_name;
         $type_name = undef;
     }
 
     register_type_constraint(
         _create_type_constraint(
-            $type_name, 'Object',
+            $type_name,
+            'Object',
             sub {
                 my $obj = $_;
-                my @missing_methods = grep { !$obj->can($_) } @methods;
-                return ! scalar @missing_methods;
+                return 0 unless all { $obj->can($_) } @methods;
+                return 1;
             },
             sub {
                 my $obj = $_;
@@ -597,7 +598,7 @@ $_->make_immutable(
     # these are Class::MOP accessors, so they need inlining
     inline_accessors => 1
     ) for grep { $_->is_mutable }
-    map { $_->meta }
+    map { Class::MOP::class_of($_) }
     qw(
     Moose::Meta::TypeConstraint
     Moose::Meta::TypeConstraint::Union
@@ -669,8 +670,7 @@ subtype 'ClassName' => as 'Str' =>
     \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
 
 subtype 'RoleName' => as 'ClassName' => where {
-    ( ( $_->can('meta') || return )->($_) || return )
-        ->isa('Moose::Meta::Role');
+    (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
 } => optimize_as
     \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
 
@@ -998,19 +998,23 @@ given type.
 
 =item B<duck_type ($name, @methods)>
 
-This will create a subtype of Object and test to make sure the value C<can()>
-do the methods in C<@methods>
+This will create a subtype of Object and test to make sure the value
+C<can()> do the methods in C<@methods>.
+
+This is intended as an easy way to accept non-Moose objects that
+provide a certain interface. If you're using Moose classes, we
+recommend that you use a C<requires>-only Role instead.
 
 =item B<duck_type (\@methods)>
 
-If passed an ARRRAY reference instead of the C<$name>, C<@methods> pair, this
-will create an unnamed duck type. This can be used in an attribute definiton
-like so:
+If passed an ARRAY reference instead of the C<$name>, C<@methods>
+pair, this will create an unnamed duck type. This can be used in an
+attribute definition like so:
 
-    has 'cache' => (
-        is  => 'ro',
-        isa => duck_type([qw[ get_set ]]),
-    );
+  has 'cache' => (
+      is  => 'ro',
+      isa => duck_type( [qw( get_set )] ),
+  );
 
 =item B<enum ($name, @values)>