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