1 package MooseX::Meta::TypeConstraint::Structured::Positional;
4 use Moose::Meta::TypeConstraint ();
5 use Moose::Util::TypeConstraints;
7 extends 'Moose::Meta::TypeConstraint';
11 MooseX::Meta::TypeConstraint::Structured::Positional - Structured Type Constraints
19 our $VERSION = '0.01';
23 Structured type constraints let you assign an internal pattern of type
24 constraints to a 'container' constraint. The goal is to make it easier to
25 declare constraints like "ArrayRef[Int, Int, Str]" where the constraint is an
26 ArrayRef of three elements and the internal constraint on the three is Int, Int
29 To accomplish this, we add an attribute to the base L<Moose::Meta::TypeConstraint>
30 to hold a L</signature>, which is a reference to a pattern of type constraints.
31 We then override L</constraint> to check our incoming value to the attribute
32 against this signature pattern.
34 Positionally structured Constraints expect the internal constraints to be in
35 'positioned' or ArrayRef style order.
39 The following types are defined in this class.
41 =head2 Moose::Meta::TypeConstraint
43 Used to make sure we can properly validate incoming signatures.
47 class_type 'Moose::Meta::TypeConstraint';
51 This class defines the following attributes.
55 This is a signature of internal contraints for the contents of the outer
62 isa=>'ArrayRef[Moose::Meta::TypeConstraint]',
66 =head2 optional_signature
68 This is a signature of internal contraints for the contents of the outer
69 contraint container. These are optional constraints.
73 has 'optional_signature' => (
75 isa=>'ArrayRef[Moose::Meta::TypeConstraint]',
76 predicate=>'has_optional_signature',
81 This class defines the following methods.
83 =head2 _normalize_args
85 Get arguments into a known state or die trying. Ideally we try to make this
86 into a HashRef so we can match it up with the L</signature> HashRef.
91 my ($self, $args) = @_;
93 if(ref $args eq 'ARRAY') {
96 confess 'Signature must be an ArrayRef type';
99 confess 'Signature cannot be empty';
105 The constraint is basically validating the L</signature> against the incoming
112 my @args = $self->_normalize_args(shift);
113 my @signature = @{$self->signature};
114 my @optional_signature = @{$self->optional_signature}
115 if $self->has_optional_signature;
117 ## First make sure all the required type constraints match
118 while( my $type_constraint = shift @signature) {
119 if(my $error = $type_constraint->validate(shift @args)) {
124 ## Now test the option type constraints.
125 while( my $arg = shift @args) {
126 my $optional_type_constraint = shift @optional_signature;
127 if(my $error = $optional_type_constraint->validate($arg)) {
132 ## If we got this far we passed!
137 =head2 signature_equals
139 Check that the signature equals another signature.
143 sub signature_equals {
144 my ($self, $compared_type_constraint) = @_;
146 foreach my $idx (0..$#{$self->signature}) {
147 my $this = $self->signature->[$idx];
148 my $that = $compared_type_constraint->signature->[$idx];
149 return unless $this->equals($that);
152 if($self->has_optional_signature) {
153 foreach my $idx (0..$#{$self->optional_signature}) {
154 my $this = $self->optional_signature->[$idx];
155 my $that = $compared_type_constraint->optional_signature->[$idx];
156 return unless $this->equals($that);
165 modifier to make sure equals descends into the L</signature>
169 around 'equals' => sub {
170 my ($equals, $self, $compared_type_constraint) = @_;
172 ## Make sure we are comparing typeconstraints of the same base class
173 return unless $compared_type_constraint->isa(__PACKAGE__);
175 ## Make sure the base equals is also good
176 return unless $self->$equals($compared_type_constraint);
178 ## Make sure the signatures match
179 return unless $self->signature_equals($compared_type_constraint);
181 ## If we get this far, the two are equal
187 John James Napiorkowski <jjnapiork@cpan.org>
191 You may distribute this code under the same terms as Perl itself.