lib/Moose/Meta/TypeCoercion/Union.pm

   1
   2 package Moose::Meta::TypeCoercion::Union;
   3
   4 use strict;
   5 use warnings;
   6 use metaclass;
   7
   8 use Scalar::Util 'blessed';
   9
  10 our $VERSION   = '0.71_01';
  11 $VERSION = eval $VERSION;
  12 our $AUTHORITY = 'cpan:STEVAN';
  13
  14 use base 'Moose::Meta::TypeCoercion';
  15
  16 sub compile_type_coercion {
  17     my $self            = shift;
  18     my $type_constraint = $self->type_constraint;
  19
  20     (blessed $type_constraint && $type_constraint->isa('Moose::Meta::TypeConstraint::Union'))
  21      || Moose->throw_error("You can only a Moose::Meta::TypeCoercion::Union for a " .
  22                 "Moose::Meta::TypeConstraint::Union, not a $type_constraint");
  23
  24     $self->_compiled_type_coercion(sub {
  25         my $value = shift;
  26         # go through all the type constraints
  27         # in the union, and check em ...
  28         foreach my $type (@{$type_constraint->type_constraints}) {
  29             # if they have a coercion first
  30             if ($type->has_coercion) {
  31                 # then try to coerce them ...
  32                 my $temp = $type->coerce($value);
  33                 # and if they get something
  34                 # make sure it still fits within
  35                 # the union type ...
  36                 return $temp if $type_constraint->check($temp);
  37             }
  38         }
  39         return undef;
  40     });
  41 }
  42
  43 sub has_coercion_for_type { 0 }
  44
  45 sub add_type_coercions {
  46     require Moose;
  47     Moose->throw_error("Cannot add additional type coercions to Union types");
  48 }
  49
  50 1;
  51
  52 __END__
  53
  54 =pod
  55
  56 =head1 NAME
  57
  58 Moose::Meta::TypeCoercion::Union - The Moose Type Coercion metaclass for Unions
  59
  60 =head1 DESCRIPTION
  61
  62 For the most part, the only time you will ever encounter an
  63 instance of this class is if you are doing some serious deep
  64 introspection. This API should not be considered final, but
  65 it is B<highly unlikely> that this will matter to a regular
  66 Moose user.
  67
  68 If you wish to use features at this depth, please come to the
  69 #moose IRC channel on irc.perl.org and we can talk :)
  70
  71 =head1 METHODS
  72
  73 =over 4
  74
  75 =item B<meta>
  76
  77 =item B<compile_type_coercion>
  78
  79 =item B<has_coercion_for_type>
  80
  81 =item B<add_type_coercions>
  82
  83 =back
  84
  85 =head1 BUGS
  86
  87 All complex software has bugs lurking in it, and this module is no
  88 exception. If you find a bug please either email me, or add the bug
  89 to cpan-RT.
  90
  91 =head1 AUTHOR
  92
  93 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  94
  95 =head1 COPYRIGHT AND LICENSE
  96
  97 Copyright 2006-2009 by Infinity Interactive, Inc.
  98
  99 L<http://www.iinteractive.com>
 100
 101 This library is free software; you can redistribute it and/or modify
 102 it under the same terms as Perl itself.
 103
 104 =cut