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.67';
  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 sub create_child_type {
  71     my ($self, @args) = @_;
  72     return Moose::Meta::TypeConstraint->new(@args, parent => $self);
  73 }
  74
  75 1;
  76
  77 __END__
  78
  79 =pod
  80
  81 =head1 NAME
  82
  83 Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values.
  84
  85 =head1 METHODS
  86
  87 =over 4
  88
  89 =item B<new>
  90
  91 =item B<equals>
  92
  93 =item B<constraint>
  94
  95 =item B<values>
  96
  97 =item B<meta>
  98
  99 =item B<create_child_type>
 100
 101 =back
 102
 103 =head1 BUGS
 104
 105 All complex software has bugs lurking in it, and this module is no
 106 exception. If you find a bug please either email me, or add the bug
 107 to cpan-RT.
 108
 109 =head1 AUTHOR
 110
 111 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
 112
 113 =head1 COPYRIGHT AND LICENSE
 114
 115 Copyright 2006-2009 by Infinity Interactive, Inc.
 116
 117 L<http://www.iinteractive.com>
 118
 119 This library is free software; you can redistribute it and/or modify
 120 it under the same terms as Perl itself.
 121
 122 =cut
 123
 124