local-lib5/lib/perl5/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.93';
  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 This is a subclass of L<Moose::Meta::TypeCoercion> that is used for
  63 L<Moose::Meta::TypeConstraint::Union> objects.
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item B<< $coercion->has_coercion_for_type >>
  69
  70 This method always returns false.
  71
  72 =item B<< $coercion->add_type_coercions >>
  73
  74 This method always throws an error. You cannot add coercions to a
  75 union type coercion.
  76
  77 =item B<< $coercion->coerce($value) >>
  78
  79 This method will coerce by trying the coercions for each type in the
  80 union.
  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-2009 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