File Coverage

blib/lib/Moose/Meta/TypeConstraint/Parameterizable.pm
Criterion Covered Total %
statement 49 50 98.0
branch 13 16 81.2
condition 2 3 66.6
subroutine 14 14 100.0
pod 0 3 0.0
total 78 86 90.7


line stmt bran cond sub pod time code
1             package Moose::Meta::TypeConstraint::Parameterizable;
2             our $VERSION = '2.2203';
3              
4 401     401   2628 use strict;
  401         873  
  401         10976  
5 401     401   1862 use warnings;
  401         806  
  401         8901  
6 401     401   1928 use metaclass;
  401         826  
  401         1961  
7              
8 401     401   2731 use parent 'Moose::Meta::TypeConstraint';
  401         917  
  401         2165  
9 401     401   25436 use Moose::Meta::TypeConstraint::Parameterized;
  401         1101  
  401         11559  
10 401     401   2433 use Moose::Util::TypeConstraints ();
  401         1067  
  401         9593  
11              
12 401     401   2358 use Moose::Util 'throw_exception';
  401         946  
  401         2658  
13              
14 401     401   91956 use Carp 'confess';
  401         893  
  401         217312  
15              
16             __PACKAGE__->meta->add_attribute('constraint_generator' => (
17             accessor => 'constraint_generator',
18             predicate => 'has_constraint_generator',
19             Class::MOP::_definition_context(),
20             ));
21              
22             __PACKAGE__->meta->add_attribute('inline_generator' => (
23             accessor => 'inline_generator',
24             predicate => 'has_inline_generator',
25             Class::MOP::_definition_context(),
26             ));
27              
28             sub generate_constraint_for {
29 341     341 0 701 my ($self, $type) = @_;
30              
31 341 50       12574 return unless $self->has_constraint_generator;
32              
33 341 100       7724 return $self->constraint_generator->($type->type_parameter)
34             if $type->is_subtype_of($self->name);
35              
36 201 100 66     5634 return $self->_can_coerce_constraint_from($type)
37             if $self->has_coercion
38             && $self->coercion->has_coercion_for_type($type->parent->name);
39              
40 199         883 return;
41             }
42              
43             sub _can_coerce_constraint_from {
44 2     2   7 my ($self, $type) = @_;
45 2         50 my $coercion = $self->coercion;
46 2         55 my $constraint = $self->constraint_generator->($type->type_parameter);
47             return sub {
48 4     4   11 local $_ = $coercion->coerce($_);
49 4         39 $constraint->(@_);
50 2         12 };
51             }
52              
53             sub generate_inline_for {
54 337     337 0 986 my ($self, $type, $val) = @_;
55              
56 337 100       11143 throw_exception( CannotGenerateInlineConstraint => parameterizable_type_object_name => $self->name,
57             type_name => $type->name,
58             value => $val,
59             )
60             unless $self->has_inline_generator;
61              
62 336         10331 return '( do { ' . $self->inline_generator->( $self, $type, $val ) . ' } )';
63             }
64              
65             sub _parse_type_parameter {
66 133     133   635 my ($self, $type_parameter) = @_;
67 133         878 return Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($type_parameter);
68             }
69              
70             sub parameterize {
71 133     133 0 470 my ($self, $type_parameter) = @_;
72              
73 133         630 my $contained_tc = $self->_parse_type_parameter($type_parameter);
74              
75             ## The type parameter should be a subtype of the parent's type parameter
76             ## if there is one.
77              
78 133 50       3592 if(my $parent = $self->parent) {
79 133 100       856 if($parent->can('type_parameter')) {
80 3 100       100 unless ( $contained_tc->is_a_type_of($parent->type_parameter) ) {
81 2         51 throw_exception( ParameterIsNotSubtypeOfParent => type_parameter => $type_parameter,
82             type_name => $self->name,
83             );
84             }
85             }
86             }
87              
88 131 50       664 if ( $contained_tc->isa('Moose::Meta::TypeConstraint') ) {
89 131         3665 my $tc_name = $self->name . '[' . $contained_tc->name . ']';
90 131         1457 return Moose::Meta::TypeConstraint::Parameterized->new(
91             name => $tc_name,
92             parent => $self,
93             type_parameter => $contained_tc,
94             parameterized_from => $self,
95             );
96             }
97             else {
98 0           confess("The type parameter must be a Moose meta type");
99             }
100             }
101              
102              
103             1;
104              
105             # ABSTRACT: Type constraints which can take a parameter (ArrayRef)
106              
107             __END__
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Moose::Meta::TypeConstraint::Parameterizable - Type constraints which can take a parameter (ArrayRef)
116              
117             =head1 VERSION
118              
119             version 2.2203
120              
121             =head1 DESCRIPTION
122              
123             This class represents a parameterizable type constraint. This is a
124             type constraint like C<ArrayRef> or C<HashRef>, that can be
125             parameterized and made more specific by specifying a contained
126             type. For example, instead of just an C<ArrayRef> of anything, you can
127             specify that is an C<ArrayRef[Int]>.
128              
129             A parameterizable constraint should not be used as an attribute type
130             constraint. Instead, when parameterized it creates a
131             L<Moose::Meta::TypeConstraint::Parameterized> which should be used.
132              
133             =head1 INHERITANCE
134              
135             C<Moose::Meta::TypeConstraint::Parameterizable> is a subclass of
136             L<Moose::Meta::TypeConstraint>.
137              
138             =head1 METHODS
139              
140             This class is intentionally not documented because the API is
141             confusing and needs some work.
142              
143             =head1 BUGS
144              
145             See L<Moose/BUGS> for details on reporting bugs.
146              
147             =head1 AUTHORS
148              
149             =over 4
150              
151             =item *
152              
153             Stevan Little <stevan@cpan.org>
154              
155             =item *
156              
157             Dave Rolsky <autarch@urth.org>
158              
159             =item *
160              
161             Jesse Luehrs <doy@cpan.org>
162              
163             =item *
164              
165             Shawn M Moore <sartak@cpan.org>
166              
167             =item *
168              
169             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
170              
171             =item *
172              
173             Karen Etheridge <ether@cpan.org>
174              
175             =item *
176              
177             Florian Ragwitz <rafl@debian.org>
178              
179             =item *
180              
181             Hans Dieter Pearcey <hdp@cpan.org>
182              
183             =item *
184              
185             Chris Prather <chris@prather.org>
186              
187             =item *
188              
189             Matt S Trout <mstrout@cpan.org>
190              
191             =back
192              
193             =head1 COPYRIGHT AND LICENSE
194              
195             This software is copyright (c) 2006 by Infinity Interactive, Inc.
196              
197             This is free software; you can redistribute it and/or modify it under
198             the same terms as the Perl 5 programming language system itself.
199              
200             =cut