lib/Moose/Meta/TypeCoercion.pm

   1
   2 package Moose::Meta::TypeCoercion;
   3
   4 use strict;
   5 use warnings;
   6 use metaclass;
   7
   8 use Moose::Meta::Attribute;
   9 use Moose::Util::TypeConstraints ();
  10
  11 __PACKAGE__->meta->add_attribute('type_coercion_map' => (
  12     reader  => 'type_coercion_map',
  13     default => sub { [] }
  14 ));
  15
  16 __PACKAGE__->meta->add_attribute(
  17     Moose::Meta::Attribute->new('type_constraint' => (
  18         reader   => 'type_constraint',
  19         weak_ref => 1
  20     ))
  21 );
  22
  23 # private accessor
  24 __PACKAGE__->meta->add_attribute('compiled_type_coercion' => (
  25     accessor => '_compiled_type_coercion'
  26 ));
  27
  28 sub new {
  29     my $class = shift;
  30     my $self  = Class::MOP::class_of($class)->new_object(@_);
  31     $self->compile_type_coercion;
  32     return $self;
  33 }
  34
  35 sub compile_type_coercion {
  36     my $self = shift;
  37     my @coercion_map = @{$self->type_coercion_map};
  38     my @coercions;
  39     while (@coercion_map) {
  40         my ($constraint_name, $action) = splice(@coercion_map, 0, 2);
  41         my $type_constraint = ref $constraint_name ? $constraint_name : Moose::Util::TypeConstraints::find_or_parse_type_constraint($constraint_name);
  42
  43         unless ( defined $type_constraint ) {
  44             require Moose;
  45             Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from");
  46         }
  47
  48         push @coercions => [
  49             $type_constraint->_compiled_type_constraint,
  50             $action
  51         ];
  52     }
  53     $self->_compiled_type_coercion(sub {
  54         my $thing = shift;
  55         foreach my $coercion (@coercions) {
  56             my ($constraint, $converter) = @$coercion;
  57             if ($constraint->($thing)) {
  58                 local $_ = $thing;
  59                 return $converter->($thing);
  60             }
  61         }
  62         return $thing;
  63     });
  64 }
  65
  66 sub has_coercion_for_type {
  67     my ($self, $type_name) = @_;
  68     my %coercion_map = @{$self->type_coercion_map};
  69     exists $coercion_map{$type_name} ? 1 : 0;
  70 }
  71
  72 sub add_type_coercions {
  73     my ($self, @new_coercion_map) = @_;
  74
  75     my $coercion_map = $self->type_coercion_map;
  76     my %has_coercion = @$coercion_map;
  77
  78     while (@new_coercion_map) {
  79         my ($constraint_name, $action) = splice(@new_coercion_map, 0, 2);
  80
  81         if ( exists $has_coercion{$constraint_name} ) {
  82             require Moose;
  83             Moose->throw_error("A coercion action already exists for '$constraint_name'")
  84         }
  85
  86         push @{$coercion_map} => ($constraint_name, $action);
  87     }
  88
  89     # and re-compile ...
  90     $self->compile_type_coercion;
  91 }
  92
  93 sub coerce { $_[0]->_compiled_type_coercion->($_[1]) }
  94
  95
  96 1;
  97
  98 # ABSTRACT: The Moose Type Coercion metaclass
  99
 100 __END__
 101
 102 =pod
 103
 104 =head1 DESCRIPTION
 105
 106 A type coercion object is basically a mapping of one or more type
 107 constraints and the associated coercions subroutines.
 108
 109 It's unlikely that you will need to instantiate an object of this
 110 class directly, as it's part of the deep internals of Moose.
 111
 112 =head1 METHODS
 113
 114 =over 4
 115
 116 =item B<< Moose::Meta::TypeCoercion->new(%options) >>
 117
 118 Creates a new type coercion object, based on the options provided.
 119
 120 =over 8
 121
 122 =item * type_constraint
 123
 124 This is the L<Moose::Meta::TypeConstraint> object for the type that is
 125 being coerced I<to>.
 126
 127 =back
 128
 129 =item B<< $coercion->type_coercion_map >>
 130
 131 This returns the map of type constraints to coercions as an array
 132 reference. The values of the array alternate between type names and
 133 subroutine references which implement the coercion.
 134
 135 The value is an array reference because coercions are tried in the
 136 order they are added.
 137
 138 =item B<< $coercion->type_constraint >>
 139
 140 This returns the L<Moose::Meta::TypeConstraint> that was passed to the
 141 constructor.
 142
 143 =item B<< $coercion->has_coercion_for_type($type_name) >>
 144
 145 Returns true if the coercion can coerce the named type.
 146
 147 =item B<< $coercion->add_type_coercions( $type_name => $sub, ... ) >>
 148
 149 This method takes a list of type names and subroutine references. If
 150 the coercion already has a mapping for a given type, it throws an
 151 exception.
 152
 153 Coercions are actually
 154
 155 =item B<< $coercion->coerce($value) >>
 156
 157 This method takes a value and applies the first valid coercion it
 158 finds.
 159
 160 This means that if the value could belong to more than type in the
 161 coercion object, the first coercion added is used.
 162
 163 =item B<< Moose::Meta::TypeCoercion->meta >>
 164
 165 This will return a L<Class::MOP::Class> instance for this class.
 166
 167 =back
 168
 169 =head1 BUGS
 170
 171 See L<Moose/BUGS> for details on reporting bugs.
 172
 173 =cut