lib/MooseX/Meta/TypeCoercion/Parameterizable.pm

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