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