1 package MooseX::Meta::TypeConstraint::Structured::Positional;
4 use Moose::Meta::TypeConstraint ();
6 extends 'Moose::Meta::TypeConstraint';
7 with 'MooseX::Meta::TypeConstraint::Role::Structured';
11 MooseX::Meta::TypeConstraint::Structured::Positional - Structured Type Constraints
15 The follow is example usage:
17 use Moose::Util::TypeConstraints;
18 use MooseX::Meta::TypeConstraint::Structured::Positional;
20 my @required = ('Str', 'Int');
21 my @optional = ('Object');
23 my $tc = MooseX::Meta::TypeConstraint::Structured::Positional->new(
25 parent => find_type_constraint('ArrayRef'),
27 find_type_constraint($_);
29 optional_signature => [map {
30 find_type_constraint($_);
36 Positionally structured Constraints expect the internal constraints to be in
37 'positioned' or ArrayRef style order. This allows you to add type constraints
38 to the internal values of the Arrayref.
42 This class defines the following attributes.
46 This is a signature of internal contraints for the contents of the outer
51 has '+signature' => (isa=>'ArrayRef[Moose::Meta::TypeConstraint]');
53 =head2 optional_signature
55 This is a signature of internal contraints for the contents of the outer
56 contraint container. These are optional constraints.
60 has '+optional_signature' => (isa=>'ArrayRef[Moose::Meta::TypeConstraint]');
64 This class defines the following methods.
66 =head2 _normalize_args
68 Get arguments into a known state or die trying. Ideally we try to make this
69 into a HashRef so we can match it up with the L</signature> HashRef.
74 my ($self, $args) = @_;
76 if(ref $args eq 'ARRAY') {
79 confess 'Signature must be an ArrayRef type';
82 confess 'Signature cannot be empty';
88 The constraint is basically validating the L</signature> against the incoming
95 my @args = $self->_normalize_args(shift);
96 my @signature = @{$self->signature};
97 my @optional_signature = @{$self->optional_signature}
98 if $self->has_optional_signature;
100 ## First make sure all the required type constraints match
101 while( my $type_constraint = shift @signature) {
102 if(my $error = $type_constraint->validate(shift @args)) {
107 ## Now test the option type constraints.
108 while( my $arg = shift @args) {
109 my $optional_type_constraint = shift @optional_signature;
110 if(my $error = $optional_type_constraint->validate($arg)) {
115 ## If we got this far we passed!
120 =head2 parse_parameter_str ($str)
122 Given a $string that is the parameter information part of a parameterized
123 constraint, parses it for internal constraint information. For example:
127 has a parameter string of "Int,Int,Str" (whitespace will automatically be
128 removed during normalization that happens in L<Moose::Util::TypeConstraints>)
129 and we need to convert that to ['Int','Int','Str'] which then has any type
130 constraints converted to true objects.
136 my $indirection = qr{=>};
137 my $divider_ops = qr{ $comma | $indirection }x;
138 my $structure_divider = qr{\s* $divider_ops \s*}x;
140 sub parse_parameter_str {
141 my ($class, $type_str) = @_;
142 my @type_strs = split($structure_divider, $type_str);
143 return map { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_) } @type_strs;
147 =head2 signature_equals
149 Check that the signature equals another signature.
153 sub signature_equals {
154 my ($self, $compared_type_constraint) = @_;
156 foreach my $idx (0..$#{$self->signature}) {
157 my $this = $self->signature->[$idx];
158 my $that = $compared_type_constraint->signature->[$idx];
159 return unless $this->equals($that);
162 if($self->has_optional_signature) {
163 foreach my $idx (0..$#{$self->optional_signature}) {
164 my $this = $self->optional_signature->[$idx];
165 my $that = $compared_type_constraint->optional_signature->[$idx];
166 return unless $this->equals($that);
175 John James Napiorkowski <jjnapiork@cpan.org>
179 You may distribute this code under the same terms as Perl itself.