File Coverage

blib/lib/Moose/Meta/TypeConstraint/Parameterized.pm
Criterion Covered Total %
statement 50 50 100.0
branch 12 14 85.7
condition 7 9 77.7
subroutine 14 14 100.0
pod 4 5 80.0
total 87 92 94.5


line stmt bran cond sub pod time code
1             package Moose::Meta::TypeConstraint::Parameterized;
2             our $VERSION = '2.2203';
3              
4 401     401   2764 use strict;
  401         854  
  401         11763  
5 401     401   1912 use warnings;
  401         844  
  401         8622  
6 401     401   1839 use metaclass;
  401         800  
  401         2011  
7              
8 401     401   2804 use Scalar::Util 'blessed';
  401         924  
  401         19497  
9 401     401   2632 use Moose::Util::TypeConstraints;
  401         974  
  401         13104  
10 401     401   174355 use Moose::Meta::TypeConstraint::Parameterizable;
  401         1253  
  401         14660  
11 401     401   2697 use Moose::Util 'throw_exception';
  401         1028  
  401         1883  
12              
13 401     401   85668 use parent 'Moose::Meta::TypeConstraint';
  401         878  
  401         1616  
14              
15             __PACKAGE__->meta->add_attribute('type_parameter' => (
16             accessor => 'type_parameter',
17             predicate => 'has_type_parameter',
18             Class::MOP::_definition_context(),
19             ));
20              
21             __PACKAGE__->meta->add_attribute('parameterized_from' => (
22             accessor => 'parameterized_from',
23             predicate => 'has_parameterized_from',
24             Class::MOP::_definition_context(),
25             ));
26              
27             sub equals {
28 132     132 1 1341 my ( $self, $type_or_name ) = @_;
29              
30 132         371 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
31              
32 132 100       1180 return unless $other->isa(__PACKAGE__);
33              
34             return (
35 8   66     244 $self->type_parameter->equals( $other->type_parameter )
36             and
37             $self->parent->equals( $other->parent )
38             );
39             }
40              
41             sub compile_type_constraint {
42 147     147 0 318 my $self = shift;
43              
44 147 100       5040 unless ( $self->has_type_parameter ) {
45 1         37 throw_exception( CannotCreateHigherOrderTypeWithoutATypeParameter => type_name => $self->name );
46             }
47              
48 146         4475 my $type_parameter = $self->type_parameter;
49              
50 146 100 66     1290 unless ( blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint') ) {
51 1         23 throw_exception( TypeParameterMustBeMooseMetaType => type_name => $self->name );
52             }
53              
54 145         636 foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) {
55 341 100       1003 if (my $constraint = $type->generate_constraint_for($self)) {
56 142         4389 $self->_set_constraint($constraint);
57 142         758 return $self->SUPER::compile_type_constraint;
58             }
59             }
60              
61             # if we get here, then we couldn't
62             # find a way to parameterize this type
63 3         68 throw_exception( TypeConstraintCannotBeUsedForAParameterizableType => type_name => $self->name,
64             parent_type_name => $self->parent->name,
65             );
66             }
67              
68             sub can_be_inlined {
69 1199     1199 1 1905 my $self = shift;
70              
71             return
72 1199   100     40252 $self->has_parameterized_from
73             && $self->parameterized_from->has_inline_generator
74             && $self->type_parameter->can_be_inlined;
75             }
76              
77             sub inline_environment {
78 614     614 1 1194 my $self = shift;
79              
80             return {
81             ($self->has_parameterized_from
82 613         16658 ? (%{ $self->parameterized_from->inline_environment })
83             : ()),
84             ($self->has_type_parameter
85 614 100       20312 ? (%{ $self->type_parameter->inline_environment })
  614 50       16398  
86             : ()),
87             };
88             }
89              
90             sub _inline_check {
91 336     336   632 my $self = shift;
92              
93 336 50       732 return unless $self->can_be_inlined;
94              
95 336         9750 return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ );
96             }
97              
98             sub create_child_type {
99 27     27 1 129 my ($self, %opts) = @_;
100 27         200 return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self);
101             }
102              
103             1;
104              
105             # ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int])
106              
107             __END__
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Moose::Meta::TypeConstraint::Parameterized - Type constraints with a bound parameter (ArrayRef[Int])
116              
117             =head1 VERSION
118              
119             version 2.2203
120              
121             =head1 METHODS
122              
123             This class is intentionally not documented because the API is
124             confusing and needs some work.
125              
126             =head1 INHERITANCE
127              
128             C<Moose::Meta::TypeConstraint::Parameterized> is a subclass of
129             L<Moose::Meta::TypeConstraint>.
130              
131             =head1 BUGS
132              
133             See L<Moose/BUGS> for details on reporting bugs.
134              
135             =head1 AUTHORS
136              
137             =over 4
138              
139             =item *
140              
141             Stevan Little <stevan@cpan.org>
142              
143             =item *
144              
145             Dave Rolsky <autarch@urth.org>
146              
147             =item *
148              
149             Jesse Luehrs <doy@cpan.org>
150              
151             =item *
152              
153             Shawn M Moore <sartak@cpan.org>
154              
155             =item *
156              
157             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
158              
159             =item *
160              
161             Karen Etheridge <ether@cpan.org>
162              
163             =item *
164              
165             Florian Ragwitz <rafl@debian.org>
166              
167             =item *
168              
169             Hans Dieter Pearcey <hdp@cpan.org>
170              
171             =item *
172              
173             Chris Prather <chris@prather.org>
174              
175             =item *
176              
177             Matt S Trout <mstrout@cpan.org>
178              
179             =back
180              
181             =head1 COPYRIGHT AND LICENSE
182              
183             This software is copyright (c) 2006 by Infinity Interactive, Inc.
184              
185             This is free software; you can redistribute it and/or modify it under
186             the same terms as the Perl 5 programming language system itself.
187              
188             =cut