Commit | Line | Data |
65748864 |
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; |