X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FEnum.pm;h=2e19a57b8542ec8a2248a87f8d307e0628a17f75;hb=9f18035c7eb2e49b5efff56c6d474a35bca40f18;hp=69cf146c220b2321f601e160a0226ff5534d5bb2;hpb=6302a7e870c9ed9bce511891a74e5bdd140fcc74;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm index 69cf146..2e19a57 100644 --- a/lib/Moose/Meta/TypeConstraint/Enum.pm +++ b/lib/Moose/Meta/TypeConstraint/Enum.pm @@ -4,22 +4,58 @@ use strict; use warnings; use metaclass; +use B; use Moose::Util::TypeConstraints (); -our $VERSION = '0.73_02'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('values' => ( accessor => 'values', )); +__PACKAGE__->meta->add_attribute('_inline_var_name' => ( + accessor => '_inline_var_name', +)); + +my $inliner = sub { + my $self = shift; + my $val = shift; + + return 'defined(' . $val . ') ' + . '&& !ref(' . $val . ') ' + . '&& $' . $self->_inline_var_name . '{' . $val . '}'; +}; + +my $var_suffix = 0; + 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 $var_name = 'enums' . $var_suffix++;; + $args{_inline_var_name} = $var_name; + $args{inline_environment} = { '%' . $var_name => \%values }; my $self = $class->_new(\%args); @@ -59,14 +95,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,14 +102,12 @@ sub create_child_type { 1; +# ABSTRACT: Type constraint for enumerated values. + __END__ =pod -=head1 NAME - -Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values. - =head1 DESCRIPTION This class represents type constraints based on an enumerated list of @@ -98,7 +124,7 @@ L. =item B<< Moose::Meta::TypeConstraint::Enum->new(%options) >> -This creates a new class type constraint based on the given +This creates a new enum type constraint based on the given C<%options>. It takes the same options as its parent, with several @@ -107,7 +133,7 @@ should be an array reference containing a list of valid string values. Second, it automatically sets the parent to the C type. Finally, it ignores any provided C option. The constraint -is generated automatically based on the provided C +is generated automatically based on the provided C. =item B<< $constraint->values >> @@ -126,22 +152,7 @@ object! =head1 BUGS -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. - -=head1 AUTHOR - -Yuval Kogman Enothingmuch@cpan.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2009 by Infinity Interactive, Inc. - -L - -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