version bump for 1.9903

[gitmo/Moose.git] / lib / Moose / Meta / TypeConstraint / Union.pm

diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index 7999c78..5a2a6f1 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -7,9 +7,7 @@ use metaclass;
 
 use Moose::Meta::TypeCoercion::Union;
 
-our $VERSION   = '0.93';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
+use List::Util qw(first);
 
 use base 'Moose::Meta::TypeConstraint';
 
@@ -30,12 +28,34 @@ sub new {
     );
 
     $self->_set_constraint(sub { $self->check($_[0]) });
-    $self->coercion(Moose::Meta::TypeCoercion::Union->new(
-        type_constraint => $self
-    ));
+
     return $self;
 }
 
+# XXX - this is a rather gross implementation of laziness for the benefit of
+# MX::Types. If we try to call ->has_coercion on the objects during object
+# construction, this does not work when defining a recursive constraint with
+# MX::Types.
+sub coercion {
+    my $self = shift;
+
+    return $self->{coercion} if exists $self->{coercion};
+
+    # Using any instead of grep here causes a weird error with some corner
+    # cases when MX::Types is in use. See RT #61001.
+    if ( grep { $_->has_coercion } @{ $self->type_constraints } ) {
+        return $self->{coercion} = Moose::Meta::TypeCoercion::Union->new(
+            type_constraint => $self );
+    }
+    else {
+        return $self->{coercion} = undef;
+    }
+}
+
+sub has_coercion {
+    return defined $_[0]->coercion;
+}
+
 sub _actually_compile_type_constraint {
     my $self = shift;
 
@@ -93,6 +113,12 @@ sub validate {
     return ($message . ' in (' . $self->name . ')') ;
 }
 
+sub find_type_for {
+    my ($self, $value) = @_;
+
+    return first { $_->check($value) } @{ $self->type_constraints };
+}
+
 sub is_a_type_of {
     my ($self, $type_name) = @_;
     foreach my $type (@{$self->type_constraints}) {
@@ -134,14 +160,12 @@ sub create_child_type {
 
 1;
 
+# ABSTRACT: A union of Moose type constraints
+
 __END__
 
 =pod
 
-=head1 NAME
-
-Moose::Meta::TypeConstraint::Union - A union of Moose type constraints
-
 =head1 DESCRIPTION
 
 This metaclass represents a union of type constraints. A union takes
@@ -197,6 +221,12 @@ messages returned by the member type constraints.
 A type is considered equal if it is also a union type, and the two
 unions have the same member types.
 
+=item B<< $constraint->find_type_for($value) >>
+
+This returns the first member type constraint for which C<check($value)> is
+true, allowing you to determine which of the Union's member type constraints
+a given value matches.
+
 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
 
 This returns true if any of the member type constraints return true
@@ -218,17 +248,4 @@ as its parent.
 
 See L<Moose/BUGS> for details on reporting bugs.
 
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 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