File Coverage

blib/lib/Moose/Meta/TypeConstraint/Enum.pm
Criterion Covered Total %
statement 65 68 95.5
branch 12 14 85.7
condition n/a
subroutine 12 14 85.7
pod 4 4 100.0
total 93 100 93.0


line stmt bran cond sub pod time code
1             package Moose::Meta::TypeConstraint::Enum;
2             our $VERSION = '2.2205';
3              
4 390     390   2975 use strict;
  390         1011  
  390         12575  
5 390     390   2177 use warnings;
  390         893  
  390         9866  
6 390     390   2186 use metaclass;
  390         948  
  390         2397  
7              
8 390     390   2947 use B;
  390         1024  
  390         17090  
9 390     390   2957 use Moose::Util::TypeConstraints ();
  390         1118  
  390         10176  
10              
11 390     390   2484 use parent 'Moose::Meta::TypeConstraint';
  390         1049  
  390         2786  
12              
13 390     390   28365 use Moose::Util 'throw_exception';
  390         1229  
  390         2965  
14              
15             __PACKAGE__->meta->add_attribute('values' => (
16             accessor => 'values',
17             Class::MOP::_definition_context(),
18             ));
19              
20             __PACKAGE__->meta->add_attribute('_inline_var_name' => (
21             accessor => '_inline_var_name',
22             Class::MOP::_definition_context(),
23             ));
24              
25             my $inliner = sub {
26             my $self = shift;
27             my $val = shift;
28              
29             return 'defined(' . $val . ') '
30             . '&& !ref(' . $val . ') '
31             . '&& $' . $self->_inline_var_name . '{' . $val . '}';
32             };
33              
34             my $var_suffix = 0;
35              
36             sub new {
37 22     22 1 1288 my ( $class, %args ) = @_;
38              
39 22         97 $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Str');
40 22         75 $args{inlined} = $inliner;
41              
42 22 100       45 if ( scalar @{ $args{values} } < 1 ) {
  22         93  
43 2         20 throw_exception( MustHaveAtLeastOneValueToEnumerate => params => \%args,
44             class => $class
45             );
46             }
47              
48 20         52 for (@{ $args{values} }) {
  20         64  
49 109 100       268 if (!defined($_)) {
    100          
50 2         13 throw_exception( EnumValuesMustBeString => params => \%args,
51             class => $class,
52             value => $_
53             );
54             }
55             elsif (ref($_)) {
56 2         13 throw_exception( EnumValuesMustBeString => params => \%args,
57             class => $class,
58             value => $_
59             );
60             }
61             }
62              
63 16         48 my %values = map { $_ => 1 } @{ $args{values} };
  103         260  
  16         47  
64 16     0   103 $args{constraint} = sub { $values{ $_[0] } };
  0         0  
65              
66 16         68 my $var_name = 'enums' . $var_suffix++;;
67 16         46 $args{_inline_var_name} = $var_name;
68 16         63 $args{inline_environment} = { '%' . $var_name => \%values };
69              
70 16         127 my $self = $class->SUPER::new(\%args);
71              
72 16 50       601 $self->compile_type_constraint()
73             unless $self->_has_compiled_type_constraint;
74              
75             $self->message( sub {
76 51     51   539 my $value = shift;
77             sprintf(
78             '%s. Value must be equal to %s.',
79             $self->_default_message->( $value ),
80 51         1502 Moose::Util::_english_list_or( map B::perlstring($_), @{ $self->values } ),
  51         1835  
81             )
82 16         550 } );
83              
84 16         100 return $self;
85             }
86              
87             sub equals {
88 5     5 1 15 my ( $self, $type_or_name ) = @_;
89              
90 5         16 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
91              
92 5 100       39 return unless $other->isa(__PACKAGE__);
93              
94 3         7 my @self_values = sort @{ $self->values };
  3         108  
95 3         8 my @other_values = sort @{ $other->values };
  3         87  
96              
97 3 100       19 return unless @self_values == @other_values;
98              
99 2         8 while ( @self_values ) {
100 8         12 my $value = shift @self_values;
101 8         17 my $other_value = shift @other_values;
102              
103 8 50       23 return unless $value eq $other_value;
104             }
105              
106 2         17 return 1;
107             }
108              
109             sub constraint {
110 151     151 1 275 my $self = shift;
111              
112 151         236 my %values = map { $_ => undef } @{ $self->values };
  621         1618  
  151         4230  
113              
114 151     14   996 return sub { exists $values{$_[0]} };
  14         101  
115             }
116              
117             sub create_child_type {
118 0     0 1   my ($self, @args) = @_;
119 0           return Moose::Meta::TypeConstraint->new(@args, parent => $self);
120             }
121              
122             1;
123              
124             # ABSTRACT: Type constraint for enumerated values.
125              
126             __END__
127              
128             =pod
129              
130             =encoding UTF-8
131              
132             =head1 NAME
133              
134             Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values.
135              
136             =head1 VERSION
137              
138             version 2.2205
139              
140             =head1 DESCRIPTION
141              
142             This class represents type constraints based on an enumerated list of
143             acceptable values.
144              
145             =head1 INHERITANCE
146              
147             C<Moose::Meta::TypeConstraint::Enum> is a subclass of
148             L<Moose::Meta::TypeConstraint>.
149              
150             =head1 METHODS
151              
152             =head2 Moose::Meta::TypeConstraint::Enum->new(%options)
153              
154             This creates a new enum type constraint based on the given
155             C<%options>.
156              
157             It takes the same options as its parent, with several
158             exceptions. First, it requires an additional option, C<values>. This
159             should be an array reference containing a list of valid string
160             values. Second, it automatically sets the parent to the C<Str> type.
161              
162             Finally, it ignores any provided C<constraint> option. The constraint
163             is generated automatically based on the provided C<values>.
164              
165             =head2 $constraint->values
166              
167             Returns the array reference of acceptable values provided to the
168             constructor.
169              
170             =head2 $constraint->create_child_type
171              
172             This returns a new L<Moose::Meta::TypeConstraint> object with the type
173             as its parent.
174              
175             Note that it does I<not> return a C<Moose::Meta::TypeConstraint::Enum>
176             object!
177              
178             =head1 BUGS
179              
180             See L<Moose/BUGS> for details on reporting bugs.
181              
182             =head1 AUTHORS
183              
184             =over 4
185              
186             =item *
187              
188             Stevan Little <stevan@cpan.org>
189              
190             =item *
191              
192             Dave Rolsky <autarch@urth.org>
193              
194             =item *
195              
196             Jesse Luehrs <doy@cpan.org>
197              
198             =item *
199              
200             Shawn M Moore <sartak@cpan.org>
201              
202             =item *
203              
204             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
205              
206             =item *
207              
208             Karen Etheridge <ether@cpan.org>
209              
210             =item *
211              
212             Florian Ragwitz <rafl@debian.org>
213              
214             =item *
215              
216             Hans Dieter Pearcey <hdp@cpan.org>
217              
218             =item *
219              
220             Chris Prather <chris@prather.org>
221              
222             =item *
223              
224             Matt S Trout <mstrout@cpan.org>
225              
226             =back
227              
228             =head1 COPYRIGHT AND LICENSE
229              
230             This software is copyright (c) 2006 by Infinity Interactive, Inc.
231              
232             This is free software; you can redistribute it and/or modify it under
233             the same terms as the Perl 5 programming language system itself.
234              
235             =cut