| 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; | ||||