File Coverage

blib/lib/Mail/Builder/Address.pm
Criterion Covered Total %
statement 32 33 96.9
branch 14 16 87.5
condition n/a
subroutine 8 9 88.8
pod 2 4 50.0
total 56 62 90.3


line stmt bran cond sub pod time code
1             # ============================================================================
2             package Mail::Builder::Address;
3             # ============================================================================
4              
5 8     8   34 use namespace::autoclean;
  8         9  
  8         67  
6 8     8   613 use Moose;
  8         12  
  8         175  
7 8     8   24836 use Mail::Builder::TypeConstraints;
  8         10  
  8         140  
8              
9 8     8   27 use Carp;
  8         5  
  8         426  
10              
11 8     8   3890 use Email::Valid;
  8         452084  
  8         4684  
12              
13             our $VERSION = $Mail::Builder::VERSION;
14              
15             has 'email' => (
16             is => 'rw',
17             isa => 'Mail::Builder::Type::EmailAddress',
18             required => 1,
19             );
20              
21             has 'name' => (
22             is => 'rw',
23             isa => 'Str',
24             predicate => 'has_name',
25             );
26              
27             has 'comment' => (
28             is => 'rw',
29             isa => 'Str',
30             predicate => 'has_comment',
31             );
32              
33             =encoding utf8
34              
35             =head1 NAME
36              
37             Mail::Builder::Address - Module for handling e-mail addresses
38              
39             =head1 SYNOPSIS
40              
41             use Mail::Builder;
42            
43             my $mail = Mail::Builder::Address->new('mightypirate@meele-island.mq','Gaybrush Thweedwood');
44             # Now correct type in the display name and address
45             $mail->name('Guybrush Threepwood');
46             $mail->email('verymightypirate@meele-island.mq');
47             $mail->comment('Mighty Pirate (TM)');
48            
49             # Serialize
50             print $mail->serialize;
51            
52             # Use the address as a recipient for Mail::Builder object
53             $mb->to($mail); # Removes all other recipients
54             OR
55             $mb->to->add($mail); # Adds one more recipient (without removing the existing ones)
56              
57             =head1 DESCRIPTION
58              
59             This is a simple module for handling e-mail addresses. It can store the address
60             and an optional display name.
61              
62             =head1 METHODS
63              
64             =head2 Constructor
65              
66             =head3 new
67              
68             Mail::Builder::Address->new(EMAIL[,DISPLAY NAME[,COMMENT]]);
69             OR
70             Mail::Builder::Address->new({
71             email => EMAIL,
72             [ name => DISPLAY NAME, ]
73             [ comment => COMMENT, ]
74             })
75             OR
76             my $email = Email::Address->parse(...);
77             Mail::Builder::Address->new($email);
78              
79             Simple constructor
80              
81             =cut
82              
83              
84             around BUILDARGS => sub {
85             my $orig = shift;
86             my $class = shift;
87             my @args = @_;
88              
89             my $args_length = scalar @args;
90             my %params;
91              
92             if ($args_length == 1) {
93             if (blessed $args[0] && $args[0]->isa('Email::Address')) {
94             $params{email} = $args[0]->address;
95             $params{name} = $args[0]->phrase;
96             $params{comment} = $args[0]->comment;
97             } elsif (ref $args[0] eq 'HASH') {
98             return $class->$orig($args[0]);
99             } elsif (ref $args[0] eq 'ARRAY') {
100             $params{email} = $args[0]->[0];
101             $params{name} = $args[0]->[1];
102             $params{comment} = $args[0]->[2];
103             } else {
104             $params{email} = $args[0];
105             }
106             } elsif ($args_length == 2
107             && $args[0] ne 'email') {
108             $params{email} = $args[0];
109             $params{name} = $args[1];
110             } elsif ($args_length == 3) {
111             $params{email} = $args[0];
112             $params{name} = $args[1];
113             $params{comment} = $args[2];
114             } else {
115             return $class->$orig(@args);
116             }
117              
118             delete $params{name}
119             unless defined $params{name} && $params{name} !~ /^\s*$/;
120             delete $params{comment}
121             unless defined $params{comment} && $params{comment} !~ /^\s*$/;
122              
123             return $class->$orig(\%params);
124             };
125              
126             sub address { ## no critic(RequireArgUnpacking)
127 4     4 0 6 my $self = shift;
128 4         83 return $self->email(@_);
129             }
130              
131             =head2 Public Methods
132              
133             =head3 serialize
134              
135             Prints the address as required for creating the e-mail header.
136              
137             =cut
138              
139             sub serialize {
140 27     27 1 29 my ($self) = @_;
141              
142 27 100       639 return $self->email
143             unless $self->has_name;
144              
145 14         284 my $name = $self->name;
146 14         24 $name =~ s/"/\\"/g;
147              
148 14         42 my $encoded = Mail::Builder::Utils::encode_mime($name);
149 14 100       4763 $encoded = qq["$encoded"]
150             unless $encoded =~ /=\?/;
151 14         341 my $return = sprintf '%s <%s>',$encoded,$self->email;
152 14 100       339 $return .= ' '.Mail::Builder::Utils::encode_mime($self->comment)
153             if $self->has_comment;
154              
155 14         154 return $return;
156             }
157              
158             =head3 compare
159              
160             $obj->compare(OBJECT);
161             or
162             $obj->compare(E-MAIL);
163              
164             Checks if two address objects contain the same e-mail address. Returns true
165             or false. The compare method does not check if the address names of the
166             two objects are identical.
167              
168             Instead of a C<Mail::Builder::Address> object you can also pass a
169             scalar value representing the e-mail address.
170              
171             =cut
172              
173             sub compare {
174 29     29 1 26 my ($self,$compare) = @_;
175              
176 29 50       39 return 0
177             unless (defined $compare);
178              
179 29 100       52 if (blessed($compare)) {
180 17 50       38 return 0 unless $compare->isa(__PACKAGE__);
181 17 100       383 return (uc($self->email) eq uc($compare->email)) ? 1:0;
182             } else {
183 12 100       44 return ( uc($compare) eq uc($self->{email}) ) ? 1:0;
184             }
185             }
186              
187             sub empty {
188 0     0 0   croak('DEPRECATED')
189             }
190              
191             __PACKAGE__->meta->make_immutable;
192              
193             1;
194              
195             =head2 Accessors
196              
197             =head3 name
198              
199             Display name
200              
201             =head3 email
202              
203             E-mail address. Will be checked with L<Email::Valid>
204             L<Email::Valid> options may be changed by setting the appropriate values
205             in the %Mail::Builder::TypeConstraints::EMAILVALID hash.
206              
207             Eg. if you want to disable the check for valid TLDs you can set the 'tldcheck'
208             option (without dashes 'tldcheck' and not '-tldcheck'):
209              
210             $Mail::Builder::TypeConstraints::EMAILVALID{tldcheck} = 0;
211              
212             Required
213              
214             =head3 comment
215              
216             Comment
217              
218             =head1 AUTHOR
219              
220             MaroÅ¡ Kollár
221             CPAN ID: MAROS
222             maros [at] k-1.com
223             http://www.k-1.com
224              
225             =cut