MooseX::Meta::TypeConstraint::Role::Structured - Structured Type Constraints
-=head1 VERSION
-
-0.01
-
-=cut
-
-our $VERSION = '0.01';
-
=head1 DESCRIPTION
-STUB - TBD
+This Role defines the interface and basic behavior of Structured Type Constraints.
=head1 TYPES
This class defines the following methods.
-=head2 _normalize_args
-
-Get arguments into a known state or die trying. Ideally we try to make this
-into a HashRef so we can match it up with the L</signature> HashRef.
-
-=head2 constraint
-
-The constraint is basically validating the L</signature> against the incoming
-
=head2 equals
modifier to make sure equals descends into the L</signature>
return 1;
};
-=head2 signature_equals
-
-Check that the signature equals another signature.
-
=head1 AUTHOR
John James Napiorkowski <jjnapiork@cpan.org>
my $self = shift;
return sub {
my %args = $self->_normalize_args(shift);
- my @signature = keys %{$self->signature};
- my @ptional_signature = keys %{$self->optional_signature}
- if $self->has_optional_signature;
## First make sure all the required type constraints match
- while( my $type_constraint_key = shift @signature) {
- my $type_constraint = $self->signature->{$type_constraint_key};
- if(my $error = $type_constraint->validate($args{$type_constraint_key})) {
+ foreach my $sig_key (keys %{$self->signature}) {
+ my $type_constraint = $self->signature->{$sig_key};
+ if(my $error = $type_constraint->validate($args{$sig_key})) {
confess $error;
+ } else {
+ delete $args{$sig_key};
}
- delete $args{$type_constraint_key};
}
## Now test the option type constraints.
- while( my $arg_key = keys %args) {
- my $optional_type_constraint = $self->signature->{$arg_key};
+ foreach my $arg_key (keys %args) {
+ my $optional_type_constraint = $self->optional_signature->{$arg_key};
if(my $error = $optional_type_constraint->validate($args{$arg_key})) {
confess $error;
}
BEGIN {
use strict;
use warnings;
- use Test::More tests=>30;
+ use Test::More tests=>35;
use Test::Exception;
}
sub Dict {
my ($args, $optional) = @_;
my %args = @$args;
- my %optional = ref $optional eq 'HASH' ? @$optional : ();
+ my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
return MooseX::Meta::TypeConstraint::Structured::Named->new(
name => 'Dict',
has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
+ has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
}
## Instantiate a new test object
}, qr/Validation failed for 'Int'/
=> 'Properly failed for bad value in optional bit';
+# Test optional_dict
+
+lives_ok sub {
+ $record->optional_dict({key1=>1,key2=>2});
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_dict, {key1=>1,key2=>2}
+ => 'correct values set';
+
+lives_ok sub {
+ $record->optional_dict({key1=>3});
+} => 'Set tuple attribute withOUT optional bits';
+
+is_deeply $record->optional_dict, {key1=>3}
+ => 'correct values set again';
+
+throws_ok sub {
+ $record->optional_dict({key1=>1,key2=>'bad'});
+}, qr/Validation failed for 'Int'/
+ => 'Properly failed for bad value in optional bit';
+
+
+
\ No newline at end of file