File: | lib/WWW/Google/Contacts/Roles/HasTypeAndLabel.pm |
Coverage: | 64.6% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WWW::Google::Contacts::Roles::HasTypeAndLabel; | ||||||
2 | |||||||
3 | 12 12 12 | 155 54 125 | use MooseX::Role::Parameterized; | ||||
4 | 12 12 12 | 158 38 108 | use MooseX::Types::Moose qw( ArrayRef Str ); | ||||
5 | 12 12 12 | 132 38 102 | use WWW::Google::Contacts::InternalTypes qw( Rel ); | ||||
6 | 12 12 12 | 202 47 157 | use Perl6::Junction qw( any ); | ||||
7 | |||||||
8 | parameter valid_types => ( | ||||||
9 | isa => ArrayRef, | ||||||
10 | required => 1, | ||||||
11 | ); | ||||||
12 | |||||||
13 | role { | ||||||
14 | my $param = shift; | ||||||
15 | my $valid_types = $param->valid_types; | ||||||
16 | |||||||
17 | has type => ( | ||||||
18 | isa => Rel, | ||||||
19 | is => 'rw', | ||||||
20 | traits => [ 'XmlField' ], | ||||||
21 | xml_key => 'rel', | ||||||
22 | predicate => 'has_type', | ||||||
23 | trigger => \&_type_set, | ||||||
24 | coerce => 1, | ||||||
25 | include_in_xml => sub { return $_[0]->has_valid_type }, | ||||||
26 | ); | ||||||
27 | |||||||
28 | has label => ( | ||||||
29 | isa => Str, | ||||||
30 | is => 'rw', | ||||||
31 | traits => [ 'XmlField' ], | ||||||
32 | xml_key => 'label', | ||||||
33 | trigger => \&_label_set, | ||||||
34 | predicate => 'has_label', | ||||||
35 | include_in_xml => sub { return ! $_[0]->has_valid_type }, | ||||||
36 | ); | ||||||
37 | |||||||
38 | method has_valid_type => sub { | ||||||
39 | 0 | 0 | my $self = shift; | ||||
40 | 0 0 | 0 0 | return any(@{ $valid_types }) eq $self->type->name ? 1 : 0; | ||||
41 | }; | ||||||
42 | }; | ||||||
43 | |||||||
44 | # To make sure type and label are always up to date with eachother | ||||||
45 | |||||||
46 | sub _type_set { | ||||||
47 | 9 | 43 | my ($self, $type) = @_; | ||||
48 | 9 | 52 | return if ( defined $self->label and $self->label eq $type->name ); | ||||
49 | 9 | 192 | $self->label( $type->name ); | ||||
50 | }; | ||||||
51 | |||||||
52 | sub _label_set { | ||||||
53 | 9 | 43 | my ($self, $label) = @_; | ||||
54 | 9 | 52 | return if ( defined $self->type and $self->type->name eq $label ); | ||||
55 | 0 | $self->type( $label ); | |||||
56 | }; | ||||||
57 | |||||||
58 | 12 12 12 | 122 47 101 | no Moose::Role; |