File | /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Parameterized.pm |
Statements Executed | 26 |
Total Time | 0.0007482 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::TypeConstraint::Parameterized::
0 | 0 | 0 | 0s | 0s | compile_type_constraint | Moose::Meta::TypeConstraint::Parameterized::
0 | 0 | 0 | 0s | 0s | create_child_type | Moose::Meta::TypeConstraint::Parameterized::
0 | 0 | 0 | 0s | 0s | equals | Moose::Meta::TypeConstraint::Parameterized::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Moose::Meta::TypeConstraint::Parameterized; | |||
2 | ||||
3 | 3 | 26µs | 9µs | use strict; # spent 8µs making 1 call to strict::import |
4 | 3 | 32µs | 11µs | use warnings; # spent 26µs making 1 call to warnings::import |
5 | 3 | 48µs | 16µs | use metaclass; # spent 859µs making 1 call to metaclass::import |
6 | ||||
7 | 3 | 31µs | 10µs | use Scalar::Util 'blessed'; # spent 47µs making 1 call to Exporter::import |
8 | 3 | 33µs | 11µs | use Moose::Util::TypeConstraints; # spent 4µs making 1 call to import |
9 | 3 | 177µs | 59µs | use Moose::Meta::TypeConstraint::Parameterizable; # spent 4µs making 1 call to import |
10 | ||||
11 | 1 | 800ns | 800ns | our $VERSION = '1.15'; |
12 | 1 | 24µs | 24µs | $VERSION = eval $VERSION; |
13 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
14 | ||||
15 | 3 | 344µs | 115µs | use base 'Moose::Meta::TypeConstraint'; # spent 88µs making 1 call to base::import |
16 | ||||
17 | 1 | 17µs | 17µs | __PACKAGE__->meta->add_attribute('type_parameter' => ( # spent 904µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
# spent 36µs making 1 call to Moose::Meta::TypeConstraint::Parameterized::meta |
18 | accessor => 'type_parameter', | |||
19 | predicate => 'has_type_parameter', | |||
20 | )); | |||
21 | ||||
22 | sub equals { | |||
23 | my ( $self, $type_or_name ) = @_; | |||
24 | ||||
25 | my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); | |||
26 | ||||
27 | return unless $other->isa(__PACKAGE__); | |||
28 | ||||
29 | return ( | |||
30 | $self->type_parameter->equals( $other->type_parameter ) | |||
31 | and | |||
32 | $self->parent->equals( $other->parent ) | |||
33 | ); | |||
34 | } | |||
35 | ||||
36 | sub compile_type_constraint { | |||
37 | my $self = shift; | |||
38 | ||||
39 | unless ( $self->has_type_parameter ) { | |||
40 | require Moose; | |||
41 | Moose->throw_error("You cannot create a Higher Order type without a type parameter"); | |||
42 | } | |||
43 | ||||
44 | my $type_parameter = $self->type_parameter; | |||
45 | ||||
46 | unless ( blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint') ) { | |||
47 | require Moose; | |||
48 | Moose->throw_error("The type parameter must be a Moose meta type"); | |||
49 | } | |||
50 | ||||
51 | foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) { | |||
52 | if (my $constraint = $type->generate_constraint_for($self)) { | |||
53 | $self->_set_constraint($constraint); | |||
54 | return $self->SUPER::compile_type_constraint; | |||
55 | } | |||
56 | } | |||
57 | ||||
58 | # if we get here, then we couldn't | |||
59 | # find a way to parameterize this type | |||
60 | require Moose; | |||
61 | Moose->throw_error("The " . $self->name . " constraint cannot be used, because " | |||
62 | . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."); | |||
63 | } | |||
64 | ||||
65 | sub create_child_type { | |||
66 | my ($self, %opts) = @_; | |||
67 | return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self); | |||
68 | } | |||
69 | ||||
70 | 1 | 14µs | 14µs | 1; |
71 | ||||
72 | __END__ | |||
73 | ||||
74 | ||||
75 | =pod | |||
76 | ||||
77 | =head1 NAME | |||
78 | ||||
79 | Moose::Meta::TypeConstraint::Parameterized - Type constraints with a bound parameter (ArrayRef[Int]) | |||
80 | ||||
81 | =head1 METHODS | |||
82 | ||||
83 | This class is intentionally not documented because the API is | |||
84 | confusing and needs some work. | |||
85 | ||||
86 | =head1 INHERITANCE | |||
87 | ||||
88 | C<Moose::Meta::TypeConstraint::Parameterized> is a subclass of | |||
89 | L<Moose::Meta::TypeConstraint>. | |||
90 | ||||
91 | =head1 BUGS | |||
92 | ||||
93 | See L<Moose/BUGS> for details on reporting bugs. | |||
94 | ||||
95 | =head1 AUTHOR | |||
96 | ||||
97 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
98 | ||||
99 | =head1 COPYRIGHT AND LICENSE | |||
100 | ||||
101 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
102 | ||||
103 | L<http://www.iinteractive.com> | |||
104 | ||||
105 | This library is free software; you can redistribute it and/or modify | |||
106 | it under the same terms as Perl itself. | |||
107 | ||||
108 | =cut |