File Coverage

blib/lib/Email/MIME/RFC2047/Mailbox.pm
Criterion Covered Total %
statement 53 54 98.1
branch 17 20 85.0
condition 8 15 53.3
subroutine 10 10 100.0
pod 5 5 100.0
total 93 104 89.4


line stmt bran cond sub pod time code
1             package Email::MIME::RFC2047::Mailbox;
2             $Email::MIME::RFC2047::Mailbox::VERSION = '0.97';
3 4     4   76669 use strict;
  4         10  
  4         145  
4 4     4   29 use warnings;
  4         9  
  4         179  
5              
6             # ABSTRACT: MIME encoded mailboxes
7              
8 4     4   27 use base qw(Email::MIME::RFC2047::Address);
  4         11  
  4         708  
9              
10 4     4   26 use Email::MIME::RFC2047::Decoder;
  4         26  
  4         111  
11 4     4   1369 use Email::MIME::RFC2047::Encoder;
  4         11  
  4         2297  
12              
13             my $domain_part_re = qr/[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?/;
14             my $addr_spec_re = qr{
15             [\w&'*+.\/=?^{}~-]+
16             \@
17             $domain_part_re (?: \. $domain_part_re)+
18             }x;
19              
20             sub new {
21 65     65 1 179 my $class = shift;
22              
23 65         93 my $self;
24              
25 65 100       175 if (@_ >= 2) {
    100          
26 35         118 $self = { @_ };
27             }
28             elsif (ref($_[0])) {
29 16         25 $self = $_[0];
30             }
31             else {
32 14         47 $self = { address => $_[0] };
33             }
34              
35 65         210 return bless($self, $class);
36             }
37              
38             sub parse {
39 30     30 1 5105 my ($class, $string, $decoder) = @_;
40 30 100       91 my $string_ref = ref($string) ? $string : \$string;
41              
42 30         51 my $mailbox;
43              
44 30 100       796 if ($$string_ref =~ /\G\s*($addr_spec_re)\s*/cg) {
45 5         21 $mailbox = $class->new($1);
46             }
47             else {
48 25   66     111 $decoder ||= Email::MIME::RFC2047::Decoder->new();
49 25         92 my $name = $decoder->decode_phrase($string_ref);
50              
51 25 100       669 $$string_ref =~ /\G<\s*($addr_spec_re)\s*>\s*/cg
52             or return $class->_parse_error($string_ref, 'mailbox');
53 18         71 my $addr_spec = $1;
54              
55 18         114 $mailbox = $class->new(name => $name, address => $addr_spec);
56             }
57              
58 23 50 66     111 if (!ref($string) && pos($string) < length($string)) {
59 0         0 return $class->_parse_error($string_ref);
60             }
61              
62 23         99 return $mailbox;
63             }
64              
65             sub name {
66 19     19 1 40 my $self = shift;
67              
68 19         31 my $old_name = $self->{name};
69 19 100       49 $self->{name} = $_[0] if @_;
70              
71 19         56 return $old_name;
72             }
73              
74             sub address {
75 4     4 1 10 my $self = shift;
76              
77 4         12 my $old_address = $self->{address};
78 4 50       13 $self->{address} = $_[0] if @_;
79              
80 4         58 return $old_address;
81             }
82              
83             sub format {
84 16     16 1 42 my ($self, $encoder) = @_;
85              
86 16         47 my $name = $self->{name};
87 16         28 my $address = $self->{address};
88 16 50 33     673 defined($address) && $address =~ /^$addr_spec_re\z/
89             or die ("invalid email address");
90              
91 16         39 my $result;
92              
93 16 100 66     77 if (!defined($name) || $name eq '') {
94 4         7 $result = $address;
95             }
96             else {
97 12   33     35 $encoder ||= Email::MIME::RFC2047::Encoder->new();
98 12         44 my $encoded_name = $encoder->encode_phrase($name);
99              
100 12         55 $result = "$encoded_name <$address>";
101             }
102              
103 16         76 return $result;
104             }
105              
106             1;
107              
108             __END__