File Coverage

blib/lib/Moose/Meta/TypeCoercion.pm
Criterion Covered Total %
statement 55 55 100.0
branch 8 10 80.0
condition n/a
subroutine 12 12 100.0
pod 4 5 80.0
total 79 82 96.3


line stmt bran cond sub pod time code
1             package Moose::Meta::TypeCoercion;
2             our $VERSION = '2.2203';
3              
4 401     401   21303 use strict;
  401         850  
  401         11738  
5 401     401   1940 use warnings;
  401         764  
  401         9139  
6 401     401   1797 use metaclass;
  401         725  
  401         1981  
7              
8 401     401   213484 use Moose::Meta::Attribute;
  401         1348  
  401         16129  
9 401     401   2964 use Moose::Util::TypeConstraints ();
  401         834  
  401         7920  
10              
11 401     401   2127 use Moose::Util 'throw_exception';
  401         847  
  401         3098  
12              
13             __PACKAGE__->meta->add_attribute('type_coercion_map' => (
14             reader => 'type_coercion_map',
15             default => sub { [] },
16             Class::MOP::_definition_context(),
17             ));
18              
19             __PACKAGE__->meta->add_attribute(
20             Moose::Meta::Attribute->new('type_constraint' => (
21             reader => 'type_constraint',
22             weak_ref => 1,
23             Class::MOP::_definition_context(),
24             ))
25             );
26              
27             # private accessor
28             __PACKAGE__->meta->add_attribute('compiled_type_coercion' => (
29             accessor => '_compiled_type_coercion',
30             Class::MOP::_definition_context(),
31             ));
32              
33             sub new {
34 43     43 1 119 my $class = shift;
35 43         180 my $self = Class::MOP::class_of($class)->new_object(@_);
36 43         188 $self->compile_type_coercion;
37 41         153 return $self;
38             }
39              
40             sub compile_type_coercion {
41 42     42 0 115 my $self = shift;
42 42         83 my @coercion_map = @{$self->type_coercion_map};
  42         1203  
43 42         94 my @coercions;
44 42         131 while (@coercion_map) {
45 50         154 my ($constraint_name, $action) = splice(@coercion_map, 0, 2);
46 50 50       225 my $type_constraint = ref $constraint_name ? $constraint_name : Moose::Util::TypeConstraints::find_or_parse_type_constraint($constraint_name);
47              
48 50 100       175 unless ( defined $type_constraint ) {
49 1         5 throw_exception( CouldNotFindTypeConstraintToCoerceFrom => constraint_name => $constraint_name,
50             instance => $self
51             );
52             }
53              
54 49         1645 push @coercions => [
55             $type_constraint->_compiled_type_constraint,
56             $action
57             ];
58             }
59             $self->_compiled_type_coercion(sub {
60 171     171   21410 my $thing = shift;
61 171         334 foreach my $coercion (@coercions) {
62 185         442 my ($constraint, $converter) = @$coercion;
63 185 100       2595 if ($constraint->($thing)) {
64 158         1683 local $_ = $thing;
65 158         393 return $converter->($thing);
66             }
67             }
68 13         125 return $thing;
69 41         1400 });
70             }
71              
72             sub has_coercion_for_type {
73 2     2 1 16 my ($self, $type_name) = @_;
74 2         3 my %coercion_map = @{$self->type_coercion_map};
  2         5  
75 2 50       14 exists $coercion_map{$type_name} ? 1 : 0;
76             }
77              
78             sub add_type_coercions {
79 5     5 1 17 my ($self, @new_coercion_map) = @_;
80              
81 5         102 my $coercion_map = $self->type_coercion_map;
82 5         20 my %has_coercion = @$coercion_map;
83              
84 5         20 while (@new_coercion_map) {
85 5         17 my ($constraint_name, $action) = splice(@new_coercion_map, 0, 2);
86              
87 5 100       19 if ( exists $has_coercion{$constraint_name} ) {
88 1         4 throw_exception( CoercionAlreadyExists => constraint_name => $constraint_name,
89             instance => $self
90             );
91             }
92              
93 4         7 push @{$coercion_map} => ($constraint_name, $action);
  4         17  
94             }
95              
96             # and re-compile ...
97 4         23 $self->compile_type_coercion;
98             }
99              
100 128     128 1 6142 sub coerce { $_[0]->_compiled_type_coercion->($_[1]) }
101              
102              
103             1;
104              
105             # ABSTRACT: The Moose Type Coercion metaclass
106              
107             __END__
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Moose::Meta::TypeCoercion - The Moose Type Coercion metaclass
116              
117             =head1 VERSION
118              
119             version 2.2203
120              
121             =head1 DESCRIPTION
122              
123             A type coercion object is basically a mapping of one or more type
124             constraints and the associated coercions subroutines.
125              
126             It's unlikely that you will need to instantiate an object of this
127             class directly, as it's part of the deep internals of Moose.
128              
129             =head1 METHODS
130              
131             =head2 Moose::Meta::TypeCoercion->new(%options)
132              
133             Creates a new type coercion object, based on the options provided.
134              
135             =over 4
136              
137             =item * type_constraint
138              
139             This is the L<Moose::Meta::TypeConstraint> object for the type that is
140             being coerced I<to>.
141              
142             =back
143              
144             =head2 $coercion->type_coercion_map
145              
146             This returns the map of type constraints to coercions as an array
147             reference. The values of the array alternate between type names and
148             subroutine references which implement the coercion.
149              
150             The value is an array reference because coercions are tried in the
151             order they are added.
152              
153             =head2 $coercion->type_constraint
154              
155             This returns the L<Moose::Meta::TypeConstraint> that was passed to the
156             constructor.
157              
158             =head2 $coercion->has_coercion_for_type($type_name)
159              
160             Returns true if the coercion can coerce the named type.
161              
162             =head2 $coercion->add_type_coercions( $type_name => $sub, ... )
163              
164             This method takes a list of type names and subroutine references. If
165             the coercion already has a mapping for a given type, it throws an
166             exception.
167              
168             Coercions are actually
169              
170             =head2 $coercion->coerce($value)
171              
172             This method takes a value and applies the first valid coercion it
173             finds.
174              
175             This means that if the value could belong to more than type in the
176             coercion object, the first coercion added is used.
177              
178             =head2 Moose::Meta::TypeCoercion->meta
179              
180             This will return a L<Class::MOP::Class> instance for this class.
181              
182             =head1 BUGS
183              
184             See L<Moose/BUGS> for details on reporting bugs.
185              
186             =head1 AUTHORS
187              
188             =over 4
189              
190             =item *
191              
192             Stevan Little <stevan@cpan.org>
193              
194             =item *
195              
196             Dave Rolsky <autarch@urth.org>
197              
198             =item *
199              
200             Jesse Luehrs <doy@cpan.org>
201              
202             =item *
203              
204             Shawn M Moore <sartak@cpan.org>
205              
206             =item *
207              
208             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
209              
210             =item *
211              
212             Karen Etheridge <ether@cpan.org>
213              
214             =item *
215              
216             Florian Ragwitz <rafl@debian.org>
217              
218             =item *
219              
220             Hans Dieter Pearcey <hdp@cpan.org>
221              
222             =item *
223              
224             Chris Prather <chris@prather.org>
225              
226             =item *
227              
228             Matt S Trout <mstrout@cpan.org>
229              
230             =back
231              
232             =head1 COPYRIGHT AND LICENSE
233              
234             This software is copyright (c) 2006 by Infinity Interactive, Inc.
235              
236             This is free software; you can redistribute it and/or modify it under
237             the same terms as the Perl 5 programming language system itself.
238              
239             =cut