lib/MooseX/Meta/TypeConstraint/Structured.pm

   1 package MooseX::Meta::TypeConstraint::Structured;
   2
   3 use 5.8.8; ## Minimum tested Perl Version
   4 use Moose;
   5 use Moose::Util::TypeConstraints;
   6
   7 extends 'Moose::Meta::TypeConstraint';
   8
   9 our $AUTHORITY = 'cpan:JJNAPIORK';
  10
  11 =head1 NAME
  12
  13 MooseX::Meta::TypeConstraint::Structured - Structured Type Constraints
  14
  15 =head1 VERSION
  16
  17 0.01
  18
  19 =cut
  20
  21 our $VERSION = '0.01';
  22
  23 =head1 DESCRIPTION
  24
  25 Structured type constraints let you assign an internal pattern of type
  26 constraints to a 'container' constraint.  The goal is to make it easier to
  27 declare constraints like "ArrayRef[Int, Int, Str]" where the constraint is an
  28 ArrayRef of three elements and the internal constraint on the three is Int, Int
  29 and Str.
  30
  31 =head1 ATTRIBUTES
  32
  33 This class defines the following attributes.
  34
  35 =head2 parent
  36
  37 additional details on the inherited parent attribute
  38
  39 =head2 signature
  40
  41 This is a signature of internal contraints for the contents of the outer
  42 contraint container.
  43
  44 =cut
  45
  46 has 'signature' => (
  47     is=>'ro',
  48     isa=>'Ref',
  49     required=>1,
  50 );
  51
  52 =head1 METHODS
  53
  54 This class defines the following methods.
  55
  56 =head2 _normalize_args
  57
  58 Get arguments into a known state or die trying
  59
  60 =cut
  61
  62 sub _normalize_args {
  63     my ($self, $args) = @_;
  64     if(defined $args && ref $args eq 'ARRAY') {
  65         return @{$args};
  66     } else {
  67         confess 'Arguments not ArrayRef as expected.';
  68     }
  69 }
  70
  71 =head2 constraint
  72
  73 The constraint is basically validating the L</signature> against the incoming
  74
  75 =cut
  76
  77 sub constraint {
  78     my $self = shift;
  79     return sub {
  80         my @args = $self->_normalize_args(shift);
  81         foreach my $idx (0..$#args) {
  82             if(my $error = $self->signature->[$idx]->validate($args[$idx])) {
  83                 confess $error;
  84             }
  85         } 1;
  86     };
  87 }
  88
  89 =head1 AUTHOR
  90
  91 John James Napiorkowski <jjnapiork@cpan.org>
  92
  93 =head1 LICENSE
  94
  95 You may distribute this code under the same terms as Perl itself.
  96
  97 =cut
  98
  99 no Moose; 1;