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 The follow is example usage:
17 use Moose::Util::TypeConstraints;
18 use MooseX::Meta::TypeConstraint::Structured::Named;
20 my %required = (key1='Str', key2=>'Int');
21 my %optional = (key3=>'Object');
23 my $tc = MooseX::Meta::TypeConstraint::Structured::Named->new(
25 parent => find_type_constraint('HashRef'),
26 package_defined_in => __PACKAGE__,
28 $_ => find_type_constraint($required{$_});
30 optional_signature => {map {
31 $_ => find_type_constraint($optional{$_});
37 Named structured Constraints expect the internal constraints to be in keys or
38 fields similar to what we expect in a HashRef. Basically, this allows you to
39 easily add type constraint checks against values in the wrapping HashRef
40 identified by the key name.
44 This class defines the following attributes.
48 This is a signature of internal contraints for the contents of the outer
53 has '+signature' => (isa=>'HashRef[Moose::Meta::TypeConstraint]');
55 =head2 optional_signature
57 This is a signature of internal contraints for the contents of the outer
58 contraint container. These are optional constraints.
62 has '+optional_signature' => (isa=>'HashRef[Moose::Meta::TypeConstraint]');
66 This class defines the following methods.
68 =head2 _normalize_args
70 Get arguments into a known state or die trying. Ideally we try to make this
71 into a HashRef so we can match it up with the L</signature> HashRef.
76 my ($self, $args) = @_;
78 if(ref $args eq 'HASH') {
81 confess 'Signature must be an HashRef type';
84 confess 'Signature cannot be empty';
90 The constraint is basically validating the L</signature> against the incoming
97 my %args = $self->_normalize_args(shift);
98 my @optional_signature;
100 if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) {
101 my $optional = pop @signature;
102 @optional_signature = @{$optional->signature};
105 ## First make sure all the required type constraints match
106 foreach my $sig_key (keys %{$self->signature}) {
107 my $type_constraint = $self->signature->{$sig_key};
108 if(my $error = $type_constraint->validate($args{$sig_key})) {
111 delete $args{$sig_key};
115 ## Now test the option type constraints.
116 foreach my $arg_key (keys %args) {
117 my $optional_type_constraint = $self->optional_signature->{$arg_key};
118 if(my $error = $optional_type_constraint->validate($args{$arg_key})) {
123 ## If we got this far we passed!
128 =head2 signature_equals
130 Check that the signature equals another signature.
134 sub signature_equals {
135 my ($self, $compared_type_constraint) = @_;
137 foreach my $idx (keys %{$self->signature}) {
138 my $this = $self->signature->{$idx};
139 my $that = $compared_type_constraint->signature->{$idx};
140 return unless $this->equals($that);
143 if($self->has_optional_signature) {
144 foreach my $idx (keys %{$self->optional_signature}) {
145 my $this = $self->optional_signature->{$idx};
146 my $that = $compared_type_constraint->optional_signature->{$idx};
147 return unless $this->equals($that);
158 John James Napiorkowski <jjnapiork@cpan.org>
162 You may distribute this code under the same terms as Perl itself.