File Coverage

blib/lib/Text/vCard/Precisely/V3/Node/Email.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package Text::vCard::Precisely::V3::Node::Email;
2              
3 28     28   208 use Carp;
  28         72  
  28         2276  
4              
5 28     28   174 use Moose;
  28         64  
  28         208  
6 28     28   182982 use Moose::Util::TypeConstraints;
  28         73  
  28         257  
7 28     28   73603 use MooseX::Types::Email qw/EmailAddress/;
  28         5333895  
  28         722  
8              
9             extends 'Text::vCard::Precisely::V3::Node';
10              
11             has name => ( is => 'ro', default => 'EMAIL', isa => 'Str' );
12             has content => ( is => 'ro', default => '', isa => EmailAddress );
13              
14             has preferred => ( is => 'rw', default => 0, isa => 'Bool' );
15              
16             subtype 'EmailType' => as 'Str' => where {
17             m/^(?:work|home)$/s or # common
18             m/^(?:contact|acquaintance|friend|met|co-worker|colleague|co-resident|neighbor|child|parent|sibling|spouse|kin|muse|crush|date|sweetheart|me|agent|emergency)$/is # 本当にこれでいのか怪しい
19             } => message {"The Email you provided, $_, was not supported in 'Type'"};
20              
21             subtype 'EmailTypes' => as 'ArrayRef[EmailType]';
22             coerce 'EmailTypes' => from 'Str' => via { [$_] };
23             has types => ( is => 'rw', isa => 'EmailTypes', default => sub { [] }, coerce => 1 );
24              
25             override 'as_string' => sub {
26             my ($self) = @_;
27             my @lines;
28             push @lines, $self->name() || croak "Empty name";
29             push @lines, 'ALTID=' . $self->altID() if $self->can('altID') and $self->altID();
30             push @lines, 'PID=' . join ',', @{ $self->pid() } if $self->can('pid') and $self->pid();
31              
32             push my @types, map { uc $_ } grep { length $_ } @{ $self->types() };
33             push @types, 'PREF' if $self->preferred();
34             my $types = 'TYPE="' . join( ',', @types ) . '"' if @types;
35             push @lines, $types if $types;
36              
37             my $string = join( ';', @lines ) . ':' . $self->content();
38             return $self->fold( $string, -force => 1 );
39             };
40              
41             __PACKAGE__->meta->make_immutable;
42 28     28   76939 no Moose;
  28         129  
  28         634  
43              
44             1;