File | /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Enum.pm |
Statements Executed | 20 |
Total Time | 0.0008008 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:75] | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:83] | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | _compile_hand_optimized_type_constraint | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | constraint | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | create_child_type | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | equals | Moose::Meta::TypeConstraint::Enum::
0 | 0 | 0 | 0s | 0s | new | Moose::Meta::TypeConstraint::Enum::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Moose::Meta::TypeConstraint::Enum; | |||
2 | ||||
3 | 3 | 26µs | 9µs | use strict; # spent 8µs making 1 call to strict::import |
4 | 3 | 28µs | 9µs | use warnings; # spent 18µs making 1 call to warnings::import |
5 | 3 | 46µs | 15µs | use metaclass; # spent 835µs making 1 call to metaclass::import |
6 | ||||
7 | 3 | 57µs | 19µs | use Moose::Util::TypeConstraints (); |
8 | ||||
9 | 1 | 800ns | 800ns | our $VERSION = '1.15'; |
10 | 1 | 22µs | 22µs | $VERSION = eval $VERSION; |
11 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
12 | ||||
13 | 3 | 591µs | 197µs | use base 'Moose::Meta::TypeConstraint'; # spent 83µs making 1 call to base::import |
14 | ||||
15 | 1 | 16µs | 16µs | __PACKAGE__->meta->add_attribute('values' => ( # spent 629µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
# spent 37µs making 1 call to Moose::Meta::TypeConstraint::Enum::meta |
16 | accessor => 'values', | |||
17 | )); | |||
18 | ||||
19 | sub new { | |||
20 | my ( $class, %args ) = @_; | |||
21 | ||||
22 | $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Str'); | |||
23 | ||||
24 | if ( scalar @{ $args{values} } < 2 ) { | |||
25 | require Moose; | |||
26 | Moose->throw_error("You must have at least two values to enumerate through"); | |||
27 | } | |||
28 | ||||
29 | for (@{ $args{values} }) { | |||
30 | if (!defined($_)) { | |||
31 | require Moose; | |||
32 | Moose->throw_error("Enum values must be strings, not undef"); | |||
33 | } | |||
34 | elsif (ref($_)) { | |||
35 | require Moose; | |||
36 | Moose->throw_error("Enum values must be strings, not '$_'"); | |||
37 | } | |||
38 | } | |||
39 | ||||
40 | my $self = $class->_new(\%args); | |||
41 | ||||
42 | $self->compile_type_constraint() | |||
43 | unless $self->_has_compiled_type_constraint; | |||
44 | ||||
45 | return $self; | |||
46 | } | |||
47 | ||||
48 | sub equals { | |||
49 | my ( $self, $type_or_name ) = @_; | |||
50 | ||||
51 | my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); | |||
52 | ||||
53 | return unless $other->isa(__PACKAGE__); | |||
54 | ||||
55 | my @self_values = sort @{ $self->values }; | |||
56 | my @other_values = sort @{ $other->values }; | |||
57 | ||||
58 | return unless @self_values == @other_values; | |||
59 | ||||
60 | while ( @self_values ) { | |||
61 | my $value = shift @self_values; | |||
62 | my $other_value = shift @other_values; | |||
63 | ||||
64 | return unless $value eq $other_value; | |||
65 | } | |||
66 | ||||
67 | return 1; | |||
68 | } | |||
69 | ||||
70 | sub constraint { | |||
71 | my $self = shift; | |||
72 | ||||
73 | my %values = map { $_ => undef } @{ $self->values }; | |||
74 | ||||
75 | return sub { exists $values{$_[0]} }; | |||
76 | } | |||
77 | ||||
78 | sub _compile_hand_optimized_type_constraint { | |||
79 | my $self = shift; | |||
80 | ||||
81 | my %values = map { $_ => undef } @{ $self->values }; | |||
82 | ||||
83 | sub { defined($_[0]) && !ref($_[0]) && exists $values{$_[0]} }; | |||
84 | } | |||
85 | ||||
86 | sub create_child_type { | |||
87 | my ($self, @args) = @_; | |||
88 | return Moose::Meta::TypeConstraint->new(@args, parent => $self); | |||
89 | } | |||
90 | ||||
91 | 1 | 13µs | 13µs | 1; |
92 | ||||
93 | __END__ | |||
94 | ||||
95 | =pod | |||
96 | ||||
97 | =head1 NAME | |||
98 | ||||
99 | Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values. | |||
100 | ||||
101 | =head1 DESCRIPTION | |||
102 | ||||
103 | This class represents type constraints based on an enumerated list of | |||
104 | acceptable values. | |||
105 | ||||
106 | =head1 INHERITANCE | |||
107 | ||||
108 | C<Moose::Meta::TypeConstraint::Enum> is a subclass of | |||
109 | L<Moose::Meta::TypeConstraint>. | |||
110 | ||||
111 | =head1 METHODS | |||
112 | ||||
113 | =over 4 | |||
114 | ||||
115 | =item B<< Moose::Meta::TypeConstraint::Enum->new(%options) >> | |||
116 | ||||
117 | This creates a new enum type constraint based on the given | |||
118 | C<%options>. | |||
119 | ||||
120 | It takes the same options as its parent, with several | |||
121 | exceptions. First, it requires an additional option, C<values>. This | |||
122 | should be an array reference containing a list of valid string | |||
123 | values. Second, it automatically sets the parent to the C<Str> type. | |||
124 | ||||
125 | Finally, it ignores any provided C<constraint> option. The constraint | |||
126 | is generated automatically based on the provided C<values>. | |||
127 | ||||
128 | =item B<< $constraint->values >> | |||
129 | ||||
130 | Returns the array reference of acceptable values provided to the | |||
131 | constructor. | |||
132 | ||||
133 | =item B<< $constraint->create_child_type >> | |||
134 | ||||
135 | This returns a new L<Moose::Meta::TypeConstraint> object with the type | |||
136 | as its parent. | |||
137 | ||||
138 | Note that it does I<not> return a C<Moose::Meta::TypeConstraint::Enum> | |||
139 | object! | |||
140 | ||||
141 | =back | |||
142 | ||||
143 | =head1 BUGS | |||
144 | ||||
145 | See L<Moose/BUGS> for details on reporting bugs. | |||
146 | ||||
147 | =head1 AUTHOR | |||
148 | ||||
149 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> | |||
150 | ||||
151 | =head1 COPYRIGHT AND LICENSE | |||
152 | ||||
153 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
154 | ||||
155 | L<http://www.iinteractive.com> | |||
156 | ||||
157 | This library is free software; you can redistribute it and/or modify | |||
158 | it under the same terms as Perl itself. | |||
159 | ||||
160 | =cut | |||
161 | ||||
162 |