X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FEnum.pm;h=b19c59b8092c9d38d7f747b419ed1ac96a755075;hb=477a812e8edd6ee5ebee1a3b7b90cfeac3b2b9f7;hp=07178cf0bec2977c0e68b70d6cff18bad865f7b6;hpb=e1737edc1aeb23724d9da1fec93ed82e900d8e00;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm index 07178cf..b19c59b 100644 --- a/lib/Moose/Meta/TypeConstraint/Enum.pm +++ b/lib/Moose/Meta/TypeConstraint/Enum.pm @@ -4,22 +4,57 @@ use strict; use warnings; use metaclass; +use B; use Moose::Util::TypeConstraints (); -our $VERSION = '0.62_02'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('values' => ( accessor => 'values', )); +our %ENUMS; + +my $inliner = sub { + my $self = shift; + my $val = shift; + + my $name = $self->name(); + $ENUMS{$name} ||= { map { $_ => 1 } @{ $self->values() } }; + + return + "defined $val" + . "&& ! ref $val" . '&& $' + . __PACKAGE__ + . '::ENUMS{' + . B::perlstring($name) + . "}{ $val }"; +}; + sub new { my ( $class, %args ) = @_; $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Str'); + $args{inlined} = $inliner; + + if ( scalar @{ $args{values} } < 2 ) { + require Moose; + Moose->throw_error("You must have at least two values to enumerate through"); + } + + for (@{ $args{values} }) { + if (!defined($_)) { + require Moose; + Moose->throw_error("Enum values must be strings, not undef"); + } + elsif (ref($_)) { + require Moose; + Moose->throw_error("Enum values must be strings, not '$_'"); + } + } + + my %values = map { $_ => 1 } @{ $args{values} }; + $args{constraint} = sub { $values{ $_[0] } }; my $self = $class->_new(\%args); @@ -59,14 +94,6 @@ sub constraint { return sub { exists $values{$_[0]} }; } -sub _compile_hand_optimized_type_constraint { - my $self = shift; - - my %values = map { $_ => undef } @{ $self->values }; - - sub { defined($_[0]) && !ref($_[0]) && exists $values{$_[0]} }; -} - sub create_child_type { my ($self, @args) = @_; return Moose::Meta::TypeConstraint->new(@args, parent => $self); @@ -74,50 +101,57 @@ sub create_child_type { 1; +# ABSTRACT: Type constraint for enumerated values. + __END__ =pod -=head1 NAME +=head1 DESCRIPTION -Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values. +This class represents type constraints based on an enumerated list of +acceptable values. -=head1 METHODS - -=over 4 +=head1 INHERITANCE -=item B +C is a subclass of +L. -=item B +=head1 METHODS -=item B +=over 4 -=item B +=item B<< Moose::Meta::TypeConstraint::Enum->new(%options) >> -=item B +This creates a new enum type constraint based on the given +C<%options>. -=item B +It takes the same options as its parent, with several +exceptions. First, it requires an additional option, C. This +should be an array reference containing a list of valid string +values. Second, it automatically sets the parent to the C type. -=back +Finally, it ignores any provided C option. The constraint +is generated automatically based on the provided C. -=head1 BUGS +=item B<< $constraint->values >> -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +Returns the array reference of acceptable values provided to the +constructor. -=head1 AUTHOR +=item B<< $constraint->create_child_type >> -Yuval Kogman Enothingmuch@cpan.orgE +This returns a new L object with the type +as its parent. -=head1 COPYRIGHT AND LICENSE +Note that it does I return a C +object! -Copyright 2006-2008 by Infinity Interactive, Inc. +=back -L +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut