2 package Moose::Meta::TypeCoercion;
8 use Moose::Meta::Attribute;
9 use Moose::Util::TypeConstraints ();
11 our $VERSION = '0.75_01';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
15 __PACKAGE__->meta->add_attribute('type_coercion_map' => (
16 reader => 'type_coercion_map',
20 __PACKAGE__->meta->add_attribute(
21 Moose::Meta::Attribute->new('type_constraint' => (
22 reader => 'type_constraint',
28 __PACKAGE__->meta->add_attribute('compiled_type_coercion' => (
29 accessor => '_compiled_type_coercion'
34 my $self = Class::MOP::class_of($class)->new_object(@_);
35 $self->compile_type_coercion;
39 sub compile_type_coercion {
41 my @coercion_map = @{$self->type_coercion_map};
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);
47 unless ( defined $type_constraint ) {
49 Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from");
53 $type_constraint->_compiled_type_constraint,
57 $self->_compiled_type_coercion(sub {
59 foreach my $coercion (@coercions) {
60 my ($constraint, $converter) = @$coercion;
61 if ($constraint->($thing)) {
63 return $converter->($thing);
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;
76 sub add_type_coercions {
77 my ($self, @new_coercion_map) = @_;
79 my $coercion_map = $self->type_coercion_map;
80 my %has_coercion = @$coercion_map;
82 while (@new_coercion_map) {
83 my ($constraint_name, $action) = splice(@new_coercion_map, 0, 2);
85 if ( exists $has_coercion{$constraint_name} ) {
87 Moose->throw_error("A coercion action already exists for '$constraint_name'")
90 push @{$coercion_map} => ($constraint_name, $action);
94 $self->compile_type_coercion;
97 sub coerce { $_[0]->_compiled_type_coercion->($_[1]) }
108 Moose::Meta::TypeCoercion - The Moose Type Coercion metaclass
112 A type coercion object is basically a mapping of one or more type
113 constraints and the associated coercions subroutines.
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.
122 =item B<< Moose::Meta::TypeCoercion->new(%options) >>
124 Creates a new type coercion object, based on the options provided.
128 =item * type_constraint
130 This is the L<Moose::Meta::TypeConstraint> object for the type that is
135 =item B<< $coercion->type_coercion_map >>
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.
141 The value is an array reference because coercions are tried in the
142 order they are added.
144 =item B<< $coercion->type_constraint >>
146 This returns the L<Moose::Meta::TypeConstraint> that was passed to the
149 =item B<< $coercion->has_coercion_for_type($type_name) >>
151 Returns true if the coercion can coerce the named type.
153 =item B<< $coercion->add_type_coercions( $type_name => $sub, ... ) >>
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
159 Coercions are actually
161 =item B<< $coercion->coerce($value) >>
163 This method takes a value and applies the first valid coercion it
166 This means that if the value could belong to more than type in the
167 coercion object, the first coercion added is used.
169 =item B<< Moose::Meta::TypeCoercion->meta >>
171 This will return a L<Class::MOP::Class> instance for this class.
177 All complex software has bugs lurking in it, and this module is no
178 exception. If you find a bug please either email me, or add the bug
183 Stevan Little E<lt>stevan@iinteractive.comE<gt>
185 =head1 COPYRIGHT AND LICENSE
187 Copyright 2006-2009 by Infinity Interactive, Inc.
189 L<http://www.iinteractive.com>
191 This library is free software; you can redistribute it and/or modify
192 it under the same terms as Perl itself.