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   = '1.19';
  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 create a Moose::Meta::TypeCoercion::Union for a " .
  22                 "Moose::Meta::TypeConstraint::Union, not a $type_constraint");
  23
  24     $self->_compiled_type_coercion(
  25         sub {
  26             my $value = shift;
  27
  28             foreach my $type ( grep { $_->has_coercion }
  29                 @{ $type_constraint->type_constraints } ) {
  30                 my $temp = $type->coerce($value);
  31                 return $temp if $type_constraint->check($temp);
  32             }
  33
  34             return $value;
  35         }
  36     );
  37 }
  38
  39 sub has_coercion_for_type { 0 }
  40
  41 sub add_type_coercions {
  42     require Moose;
  43     Moose->throw_error("Cannot add additional type coercions to Union types");
  44 }
  45
  46 1;
  47
  48 __END__
  49
  50 =pod
  51
  52 =head1 NAME
  53
  54 Moose::Meta::TypeCoercion::Union - The Moose Type Coercion metaclass for Unions
  55
  56 =head1 DESCRIPTION
  57
  58 This is a subclass of L<Moose::Meta::TypeCoercion> that is used for
  59 L<Moose::Meta::TypeConstraint::Union> objects.
  60 =head1 METHODS
  61
  62 =over 4
  63
  64 =item B<< $coercion->has_coercion_for_type >>
  65
  66 This method always returns false.
  67
  68 =item B<< $coercion->add_type_coercions >>
  69
  70 This method always throws an error. You cannot add coercions to a
  71 union type coercion.
  72
  73 =item B<< $coercion->coerce($value) >>
  74
  75 This method will coerce by trying the coercions for each type in the
  76 union.
  77
  78 =back
  79
  80 =head1 BUGS
  81
  82 See L<Moose/BUGS> for details on reporting bugs.
  83
  84 =head1 AUTHOR
  85
  86 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  87
  88 =head1 COPYRIGHT AND LICENSE
  89
  90 Copyright 2006-2010 by Infinity Interactive, Inc.
  91
  92 L<http://www.iinteractive.com>
  93
  94 This library is free software; you can redistribute it and/or modify
  95 it under the same terms as Perl itself.
  96
  97 =cut