X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FGitalist.git;a=blobdiff_plain;f=local-lib5%2Flib%2Fperl5%2FMoose%2FMeta%2FTypeConstraint%2FEnum.pm;fp=local-lib5%2Flib%2Fperl5%2FMoose%2FMeta%2FTypeConstraint%2FEnum.pm;h=926a55d548c4e1dedca2038c1bc4b73cd857c3f2;hp=0000000000000000000000000000000000000000;hb=3fea05b9fbf95091f4522528b9980a33e0235603;hpb=af746827daa7a8feccee889e1d12ebc74cc9201e diff --git a/local-lib5/lib/perl5/Moose/Meta/TypeConstraint/Enum.pm b/local-lib5/lib/perl5/Moose/Meta/TypeConstraint/Enum.pm new file mode 100644 index 0000000..926a55d --- /dev/null +++ b/local-lib5/lib/perl5/Moose/Meta/TypeConstraint/Enum.pm @@ -0,0 +1,148 @@ +package Moose::Meta::TypeConstraint::Enum; + +use strict; +use warnings; +use metaclass; + +use Moose::Util::TypeConstraints (); + +our $VERSION = '0.93'; +$VERSION = eval $VERSION; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Moose::Meta::TypeConstraint'; + +__PACKAGE__->meta->add_attribute('values' => ( + accessor => 'values', +)); + +sub new { + my ( $class, %args ) = @_; + + $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Str'); + + my $self = $class->_new(\%args); + + $self->compile_type_constraint() + unless $self->_has_compiled_type_constraint; + + return $self; +} + +sub equals { + my ( $self, $type_or_name ) = @_; + + my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); + + return unless $other->isa(__PACKAGE__); + + my @self_values = sort @{ $self->values }; + my @other_values = sort @{ $other->values }; + + return unless @self_values == @other_values; + + while ( @self_values ) { + my $value = shift @self_values; + my $other_value = shift @other_values; + + return unless $value eq $other_value; + } + + return 1; +} + +sub constraint { + my $self = shift; + + my %values = map { $_ => undef } @{ $self->values }; + + 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); +} + +1; + +__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 +acceptable values. + +=head1 INHERITANCE + +C is a subclass of +L. + +=head1 METHODS + +=over 4 + +=item B<< Moose::Meta::TypeConstraint::Enum->new(%options) >> + +This creates a new enum type constraint based on the given +C<%options>. + +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. + +Finally, it ignores any provided C option. The constraint +is generated automatically based on the provided C. + +=item B<< $constraint->values >> + +Returns the array reference of acceptable values provided to the +constructor. + +=item B<< $constraint->create_child_type >> + +This returns a new L object with the type +as its parent. + +Note that it does I return a C +object! + +=back + +=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. + +=cut + +