lib/Moose/Meta/TypeConstraint/Enum.pm

   1 package Moose::Meta::TypeConstraint::Enum;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Moose::Util::TypeConstraints ();
   8
   9 our $VERSION   = '0.56';
  10 our $AUTHORITY = 'cpan:STEVAN';
  11
  12 use base 'Moose::Meta::TypeConstraint';
  13
  14 __PACKAGE__->meta->add_attribute('values' => (
  15     accessor => 'values',
  16 ));
  17
  18 sub new {
  19     my ( $class, %args ) = @_;
  20
  21     $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Str');
  22
  23     my $self = $class->_new(\%args);
  24
  25     $self->compile_type_constraint()
  26         unless $self->_has_compiled_type_constraint;
  27
  28     return $self;
  29 }
  30
  31 sub equals {
  32     my ( $self, $type_or_name ) = @_;
  33
  34     my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
  35
  36     return unless $other->isa(__PACKAGE__);
  37
  38     my @self_values  = sort @{ $self->values };
  39     my @other_values = sort @{ $other->values };
  40
  41     return unless @self_values == @other_values;
  42
  43     while ( @self_values ) {
  44         my $value = shift @self_values;
  45         my $other_value = shift @other_values;
  46
  47         return unless $value eq $other_value;
  48     }
  49
  50     return 1;
  51 }
  52
  53 sub constraint {
  54     my $self = shift;
  55
  56     my %values = map { $_ => undef } @{ $self->values };
  57
  58     return sub { exists $values{$_[0]} };
  59 }
  60
  61 sub _compile_hand_optimized_type_constraint {
  62     my $self  = shift;
  63
  64     my %values = map { $_ => undef } @{ $self->values };
  65
  66     sub { defined($_[0]) && !ref($_[0]) && exists $values{$_[0]} };
  67 }
  68
  69 1;
  70
  71 __END__
  72
  73 =pod
  74
  75 =head1 NAME
  76
  77 Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values.
  78
  79 =head1 METHODS
  80
  81 =over 4
  82
  83 =item B<new>
  84
  85 =item B<equals>
  86
  87 =item B<constraint>
  88
  89 =item B<values>
  90
  91 =item B<meta>
  92
  93 =back
  94
  95 =head1 BUGS
  96
  97 All complex software has bugs lurking in it, and this module is no
  98 exception. If you find a bug please either email me, or add the bug
  99 to cpan-RT.
 100
 101 =head1 AUTHOR
 102
 103 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
 104
 105 =head1 COPYRIGHT AND LICENSE
 106
 107 Copyright 2006-2008 by Infinity Interactive, Inc.
 108
 109 L<http://www.iinteractive.com>
 110
 111 This library is free software; you can redistribute it and/or modify
 112 it under the same terms as Perl itself.
 113
 114 =cut
 115
 116