1 package MooseX::Meta::TypeConstraint::Structured::Named;
4 use Moose::Meta::TypeConstraint ();
6 extends 'Moose::Meta::TypeConstraint';
7 with 'MooseX::Meta::TypeConstraint::Role::Structured';
11 MooseX::Meta::TypeConstraint::Structured::Named - Structured Type Constraints
15 Structured type constraints let you assign an internal pattern of type
16 constraints to a 'container' constraint. The goal is to make it easier to
17 declare constraints like "ArrayRef[Int, Int, Str]" where the constraint is an
18 ArrayRef of three elements and the internal constraint on the three is Int, Int
21 To accomplish this, we add an attribute to the base L<Moose::Meta::TypeConstraint>
22 to hold a L</signature>, which is a reference to a pattern of type constraints.
23 We then override L</constraint> to check our incoming value to the attribute
24 against this signature pattern.
26 Named structured Constraints expect the internal constraints to be in keys or
27 fields similar to what we expect in a HashRef.
31 This class defines the following attributes.
35 This is a signature of internal contraints for the contents of the outer
40 has '+signature' => (isa=>'HashRef[Moose::Meta::TypeConstraint]');
42 =head2 optional_signature
44 This is a signature of internal contraints for the contents of the outer
45 contraint container. These are optional constraints.
49 has '+optional_signature' => (isa=>'HashRef[Moose::Meta::TypeConstraint]');
53 This class defines the following methods.
55 =head2 _normalize_args
57 Get arguments into a known state or die trying. Ideally we try to make this
58 into a HashRef so we can match it up with the L</signature> HashRef.
63 my ($self, $args) = @_;
65 if(ref $args eq 'HASH') {
68 confess 'Signature must be an HashRef type';
71 confess 'Signature cannot be empty';
77 The constraint is basically validating the L</signature> against the incoming
84 my %args = $self->_normalize_args(shift);
85 my @signature = keys %{$self->signature};
86 my @ptional_signature = keys %{$self->optional_signature}
87 if $self->has_optional_signature;
89 ## First make sure all the required type constraints match
90 while( my $type_constraint_key = shift @signature) {
91 my $type_constraint = $self->signature->{$type_constraint_key};
92 if(my $error = $type_constraint->validate($args{$type_constraint_key})) {
95 delete $args{$type_constraint_key};
98 ## Now test the option type constraints.
99 while( my $arg_key = keys %args) {
100 my $optional_type_constraint = $self->signature->{$arg_key};
101 if(my $error = $optional_type_constraint->validate($args{$arg_key})) {
106 ## If we got this far we passed!
111 =head2 signature_equals
113 Check that the signature equals another signature.
117 sub signature_equals {
118 my ($self, $compared_type_constraint) = @_;
120 foreach my $idx (keys %{$self->signature}) {
121 my $this = $self->signature->{$idx};
122 my $that = $compared_type_constraint->signature->{$idx};
123 return unless $this->equals($that);
126 if($self->has_optional_signature) {
127 foreach my $idx (keys %{$self->optional_signature}) {
128 my $this = $self->optional_signature->{$idx};
129 my $that = $compared_type_constraint->optional_signature->{$idx};
130 return unless $this->equals($that);
141 John James Napiorkowski <jjnapiork@cpan.org>
145 You may distribute this code under the same terms as Perl itself.