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);
99 ## First make sure all the required type constraints match
100 foreach my $sig_key (keys %{$self->signature}) {
101 my $type_constraint = $self->signature->{$sig_key};
102 if(my $error = $type_constraint->validate($args{$sig_key})) {
105 delete $args{$sig_key};
109 ## Now test the option type constraints.
110 foreach my $arg_key (keys %args) {
111 my $optional_type_constraint = $self->optional_signature->{$arg_key};
112 if(my $error = $optional_type_constraint->validate($args{$arg_key})) {
117 ## If we got this far we passed!
122 =head2 signature_equals
124 Check that the signature equals another signature.
128 sub signature_equals {
129 my ($self, $compared_type_constraint) = @_;
131 foreach my $idx (keys %{$self->signature}) {
132 my $this = $self->signature->{$idx};
133 my $that = $compared_type_constraint->signature->{$idx};
134 return unless $this->equals($that);
137 if($self->has_optional_signature) {
138 foreach my $idx (keys %{$self->optional_signature}) {
139 my $this = $self->optional_signature->{$idx};
140 my $that = $compared_type_constraint->optional_signature->{$idx};
141 return unless $this->equals($that);
152 John James Napiorkowski <jjnapiork@cpan.org>
156 You may distribute this code under the same terms as Perl itself.