File Coverage

blib/lib/Email/MIME/RFC2047/Address.pm
Criterion Covered Total %
statement 42 43 97.6
branch 15 18 83.3
condition 4 6 66.6
subroutine 8 8 100.0
pod 1 1 100.0
total 70 76 92.1


line stmt bran cond sub pod time code
1             package Email::MIME::RFC2047::Address;
2             $Email::MIME::RFC2047::Address::VERSION = '0.96';
3 4     4   91913 use strict;
  4         12  
  4         146  
4 4     4   30 use warnings;
  4         12  
  4         191  
5              
6             # ABSTRACT: Handling of MIME encoded addresses
7              
8 4     4   44 use base qw(Email::MIME::RFC2047::Parser);
  4         11  
  4         1408  
9              
10 4     4   1343 use Email::MIME::RFC2047::Decoder;
  4         15  
  4         158  
11 4     4   2338 use Email::MIME::RFC2047::Group;
  4         14  
  4         262  
12 4     4   435 use Email::MIME::RFC2047::Mailbox;
  4         13  
  4         125  
13 4     4   32 use Email::MIME::RFC2047::MailboxList;
  4         10  
  4         1681  
14              
15             my $domain_part_re = qr/[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?/;
16             my $addr_spec_re = qr{
17             [\w&'*+.\/=?^{}~-]+
18             \@
19             $domain_part_re (?: \. $domain_part_re)+
20             }x;
21              
22             sub parse {
23 36     36 1 16907 my ($class, $string, $decoder) = @_;
24 36 100       153 my $string_ref = ref($string) ? $string : \$string;
25              
26 36         79 my $address;
27              
28 36 100       929 if ($$string_ref =~ /\G\s*($addr_spec_re)\s*/cg) {
29 9         52 $address = Email::MIME::RFC2047::Mailbox->new($1);
30             }
31             else {
32 27   66     225 $decoder ||= Email::MIME::RFC2047::Decoder->new();
33 27         124 my $name = $decoder->decode_phrase($string_ref);
34              
35 27 100       628 if ($$string_ref =~ /\G<\s*($addr_spec_re)\s*>\s*/cg) {
    100          
36 17         79 my $addr_spec = $1;
37              
38 17         97 $address = Email::MIME::RFC2047::Mailbox->new(
39             address => $addr_spec,
40             );
41              
42 17 100       115 $address->name($name) if $name ne '';
43             }
44             elsif ($$string_ref =~ /\G:/cg) {
45 8 50       38 return $class->_parse_error($string_ref, 'group name')
46             if $name eq '';
47              
48 8         17 my $mailbox_list;
49              
50 8 100       46 if ($$string_ref =~ /\G\s*;\s*/cg) {
51 2         13 $mailbox_list = Email::MIME::RFC2047::MailboxList->new();
52             }
53             else {
54 6         63 $mailbox_list = Email::MIME::RFC2047::MailboxList->parse(
55             $string_ref, $decoder
56             );
57              
58 4 50       27 $$string_ref =~ /\G;\s*/cg
59             or return $class->_parse_error($string_ref, 'group');
60             }
61              
62 6         47 $address = Email::MIME::RFC2047::Group->new(
63             name => $name,
64             mailbox_list => $mailbox_list,
65             );
66             }
67             else {
68 2         19 return $class->_parse_error($string_ref, 'address');
69             }
70             }
71              
72 32 50 66     201 if (!ref($string) && pos($string) < length($string)) {
73 0         0 return $class->_parse_error($string_ref);
74             }
75              
76 32         187 return $address;
77             }
78              
79             1;
80              
81             __END__