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