docs changes all over
[gitmo/MooseX-Dependent.git] / lib / MooseX / Meta / TypeCoercion / Parameterizable.pm
CommitLineData
3cfd35fd 1package ## Hide from PAUSE
ca01e833 2 MooseX::Meta::TypeCoercion::Parameterizable;
3cfd35fd 3
4use Moose;
5extends 'Moose::Meta::TypeCoercion';
6
7=head1 NAME
8
88f7dcd2 9MooseX::Meta::TypeCoercion::Parameterizable - Coerce Parameterizable type constraints.
3cfd35fd 10
11=head1 DESCRIPTION
12
9e662b6a 13Coercion Meta Class, intended to make sure coercions work correctly with
14parameterized types. You probably won't consume or subclass this class directly
15
3cfd35fd 16=head1 METHODS
17
18This class defines the following methods.
19
0af9bd45 20=head add_type_coercions
26cf337e 21
0af9bd45 22method modification to throw exception should we try to add a coercion on a
9e662b6a 23parameterizable type that is already defined by a constraining value. We do
24this since defined parameterizable type constraints inherit their coercion from
25the parent constraint. It makes no sense to even be using parameterizable
26types if you know the constraining value beforehand!
26cf337e 27
0af9bd45 28=cut
26cf337e 29
30around 'add_type_coercions' => sub {
31 my ($add_type_coercions, $self, @args) = @_;
32 if($self->type_constraint->has_constraining_value) {
88f7dcd2 33 Moose->throw_error("Cannot add type coercions to a parameterizable type constraint that's been defined.");
26cf337e 34 } else {
35 return $self->$add_type_coercions(@args);
36 }
37};
38
0af9bd45 39
91623f94 40## These two are here until I can merge change upstream to Moose. These are two
9e662b6a 41## very minor changes we can probably just put into Moose without breaking stuff.
42## Hopefully can can eventually stop doing this.
1a6ad4bd 43
0af9bd45 44sub coerce {
45 my $self = shift @_;
46 my $coderef = $self->_compiled_type_coercion;
9e662b6a 47 return $coderef->(@_); ## <== in Moose we don't call on @_, but $_[1]
0af9bd45 48}
49
26cf337e 50sub compile_type_coercion {
51 my $self = shift;
52 my @coercion_map = @{$self->type_coercion_map};
53 my @coercions;
54 while (@coercion_map) {
55 my ($constraint_name, $action) = splice(@coercion_map, 0, 2);
1a6ad4bd 56
57 my $type_constraint = ref $constraint_name
58 ? $constraint_name
59 : Moose::Util::TypeConstraints::find_or_parse_type_constraint($constraint_name);
26cf337e 60
61 unless ( defined $type_constraint ) {
62 require Moose;
63 Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from");
64 }
65
66 push @coercions => [
67 $type_constraint->_compiled_type_constraint,
68 $action
69 ];
70 }
71 $self->_compiled_type_coercion(sub {
72 my $thing = shift;
73 foreach my $coercion (@coercions) {
74 my ($constraint, $converter) = @$coercion;
75 if ($constraint->($thing)) {
76 local $_ = $thing;
9e662b6a 77 return $converter->($thing, @_); ## <== Here also we pass @_ which Moose doesn't
26cf337e 78 }
79 }
80 return $thing;
81 });
82}
83
3cfd35fd 84=head1 SEE ALSO
85
86The following modules or resources may be of interest.
87
88L<Moose>, L<Moose::Meta::TypeCoercion>
89
90=head1 AUTHOR
91
92John Napiorkowski, C<< <jjnapiork@cpan.org> >>
93
94=head1 COPYRIGHT & LICENSE
95
96This program is free software; you can redistribute it and/or modify
97it under the same terms as Perl itself.
98
99=cut
100
74eefd2e 101__PACKAGE__->meta->make_immutable(inline_constructor => 0);