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