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.57';
  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     Moose->throw_error("Cannot add additional type coercions to Union types");
  47 }
  48
  49 1;
  50
  51 __END__
  52
  53 =pod
  54
  55 =head1 NAME
  56
  57 Moose::Meta::TypeCoercion::Union - The Moose Type Coercion metaclass for Unions
  58
  59 =head1 DESCRIPTION
  60
  61 For the most part, the only time you will ever encounter an
  62 instance of this class is if you are doing some serious deep
  63 introspection. This API should not be considered final, but
  64 it is B<highly unlikely> that this will matter to a regular
  65 Moose user.
  66
  67 If you wish to use features at this depth, please come to the
  68 #moose IRC channel on irc.perl.org and we can talk :)
  69
  70 =head1 METHODS
  71
  72 =over 4
  73
  74 =item B<meta>
  75
  76 =item B<compile_type_coercion>
  77
  78 =item B<has_coercion_for_type>
  79
  80 =item B<add_type_coercions>
  81
  82 =back
  83
  84 =head1 BUGS
  85
  86 All complex software has bugs lurking in it, and this module is no
  87 exception. If you find a bug please either email me, or add the bug
  88 to cpan-RT.
  89
  90 =head1 AUTHOR
  91
  92 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  93
  94 =head1 COPYRIGHT AND LICENSE
  95
  96 Copyright 2006-2008 by Infinity Interactive, Inc.
  97
  98 L<http://www.iinteractive.com>
  99
 100 This library is free software; you can redistribute it and/or modify
 101 it under the same terms as Perl itself.
 102
 103 =cut