File Coverage

blib/lib/Net/IMAP/Client/MsgSummary.pm
Criterion Covered Total %
statement 6 175 3.4
branch 0 54 0.0
condition 0 19 0.0
subroutine 2 46 4.3
pod 38 38 100.0
total 46 332 13.8


line stmt bran cond sub pod time code
1             package Net::IMAP::Client::MsgSummary;
2              
3 1     1   558 use Encode ();
  1         9673  
  1         27  
4 1     1   408 use Net::IMAP::Client::MsgAddress ();
  1         2  
  1         2132  
5              
6             sub new {
7 0     0 1   my ($class, $data, $part_id, $has_headers) = @_;
8              
9 0           bless my $self = {}, $class;
10              
11 0 0         if ($part_id) {
12 0           $self->{part_id} = $part_id;
13             }
14              
15 0           my $tmp = $data->{BODY};
16 0 0         if ($tmp) {
17 0           $self->_parse_body($tmp);
18             }
19              
20 0           $tmp = $data->{BODYSTRUCTURE};
21 0 0         if ($tmp) {
22 0           $self->_parse_bodystructure($tmp);
23             }
24              
25 0           $tmp = $data->{ENVELOPE};
26 0 0         if ($tmp) {
27 0           $self->_parse_envelope($tmp);
28             }
29              
30 0           $self->{flags} = $data->{FLAGS};
31 0           $self->{internaldate} = $data->{INTERNALDATE};
32 0           $self->{rfc822_size} = $data->{'RFC822.SIZE'};
33 0           $self->{uid} = $data->{UID};
34              
35 0 0         if ($has_headers) {
36 0           while (my ($key, $val) = each %$data) {
37 0 0         if ($key =~ /^body(?:\.peek)?\s*\[\s*header\.fields/i) {
38 0           $self->{headers} = $val;
39 0           last;
40             }
41             }
42             }
43              
44 0           return $self;
45             }
46              
47             sub _decode {
48 0     0     my ($str) = @_;
49 0 0         if (defined($str)) {
50 0           eval { $str = Encode::decode('MIME-Header', $str); };
  0            
51             }
52 0           return $str;
53             }
54              
55 0     0 1   sub type { $_[0]->{type} }
56              
57 0     0 1   sub subtype { $_[0]->{subtype} }
58              
59 0     0 1   sub parameters { $_[0]->{parameters} }
60              
61 0     0 1   sub cid { $_[0]->{cid} }
62              
63 0     0 1   sub description { _decode($_[0]->{description}) }
64              
65 0     0 1   sub transfer_encoding { $_[0]->{transfer_encoding} }
66              
67 0     0 1   sub encoded_size { $_[0]->{encoded_size} }
68              
69             sub content_type {
70 0     0 1   my ($self) = @_;
71 0 0         if ($self->type) {
72 0           return $self->type . '/' . $self->subtype;
73             }
74 0 0         if ($self->multipart) {
75 0           return 'multipart/' . $self->multipart;
76             }
77 0           return undef;
78             }
79              
80 0     0 1   sub charset { $_[0]->{parameters}->{charset} }
81              
82             sub filename {
83 0     0 1   my ($self) = @_;
84 0           my $disp = $self->{disposition};
85 0           my $filename;
86 0 0         if ($disp) {
87 0           while (my ($key, $val) = each %$disp) {
88 0 0         if (ref($val) eq 'HASH') {
89 0           $filename = $val->{filename};
90 0 0         last if $filename;
91             }
92             }
93             }
94 0 0         unless ($filename) {
95 0           $filename = $_[0]->{parameters}->{name};
96             }
97 0           return _decode($filename);
98             }
99              
100 0     0 1   sub name { _decode($_[0]->{parameters}->{name}) }
101              
102 0     0 1   sub multipart { $_[0]->{multipart_type} }
103              
104 0     0 1   sub parts { $_[0]->{parts} }
105              
106 0     0 1   sub rfc822_size { $_[0]->{rfc822_size} }
107              
108 0     0 1   sub internaldate { $_[0]->{internaldate} }
109              
110 0     0 1   sub flags { $_[0]->{flags} }
111              
112 0     0 1   sub uid { $_[0]->{uid} }
113              
114 0     0 1   sub part_id { $_[0]->{part_id } }
115              
116 0     0 1   sub md5 { $_[0]->{md5} }
117              
118 0     0 1   sub disposition { $_[0]->{disposition} }
119              
120 0     0 1   sub language { $_[0]->{language} }
121              
122             # envelope
123              
124 0     0 1   sub date { $_[0]->{date} }
125              
126 0     0 1   sub subject { _decode($_[0]->{subject}) }
127              
128 0     0 1   sub from { $_[0]->{from} }
129              
130 0     0 1   sub sender { $_[0]->{sender} }
131              
132 0     0 1   sub reply_to { $_[0]->{reply_to} }
133              
134 0     0 1   sub to { $_[0]->{to} }
135              
136 0     0 1   sub cc { $_[0]->{cc} }
137              
138 0     0 1   sub bcc { $_[0]->{bcc} }
139              
140 0     0 1   sub in_reply_to { $_[0]->{in_reply_to} }
141              
142 0     0 1   sub message_id { $_[0]->{message_id} }
143              
144 0     0 1   sub seq_id { $_[0]->{seq_id} }
145              
146 0     0 1   sub headers { $_[0]->{headers} }
147              
148             # utils
149              
150             sub get_subpart {
151 0     0 1   my ($self, $part) = @_;
152 0           foreach my $index (split(/\./, $part)) {
153 0           $self = $self->parts->[$index - 1];
154             }
155 0           return $self;
156             }
157              
158             my %MT_HAS_ATTACHMENT = ( mixed => 1 );
159              
160             sub has_attachments {
161 0     0 1   my ($self) = @_;
162 0           my $mt = $self->multipart;
163 0 0 0       return $mt && $MT_HAS_ATTACHMENT{$mt} ? 1 : 0;
164             }
165              
166 0     0 1   sub is_message { $_[0]->content_type eq 'message/rfc822' }
167              
168 0     0 1   sub message { $_[0]->{message} }
169              
170             sub _parse_body {
171 0     0     my ($self, $struct) = @_;
172              
173 0 0         if (ref($struct->[0]) eq 'ARRAY') {
174 0           my @tmp = @$struct;
175 0           my $multipart = pop @tmp;
176 0   0       my $part_id = $self->{part_id} || '';
177 0 0         $part_id .= '.'
178             if $part_id;
179 0           my $i = 0;
180 0           @tmp = map { __PACKAGE__->new({ BODY => $_}, $part_id . ++$i) } @tmp;
  0            
181 0           $self->{multipart_type} = lc $multipart;
182 0           $self->{parts} = \@tmp;
183             } else {
184 0           $self->{type} = lc $struct->[0];
185 0           $self->{subtype} = lc $struct->[1];
186 0 0         if ($struct->[2]) {
187 0           my %tmp = @{$struct->[2]};
  0            
188 0           $self->{parameters} = \%tmp;
189             }
190 0           $self->{cid} = $struct->[3];
191 0           $self->{description} = $struct->[4];
192 0           $self->{transfer_encoding} = $struct->[5];
193 0           $self->{encoded_size} = $struct->[6];
194              
195 0 0 0       if ($self->is_message && $struct->[7] && $struct->[8]) {
      0        
196             # continue parsing attached message
197 0           $self->{message} = __PACKAGE__->new({
198             ENVELOPE => $struct->[7],
199             BODY => $struct->[8],
200             });
201             }
202             }
203             }
204              
205             sub _parse_bodystructure {
206 0     0     my ($self, $struct) = @_;
207              
208 0 0         if (ref($struct->[0]) eq 'ARRAY') {
209 0           my $multipart;
210             my @tmp;
211 0           foreach (@$struct) {
212 0 0         if (ref($_) eq 'ARRAY') {
213 0           push @tmp, $_;
214             } else {
215 0           $multipart = $_;
216 0           last; # XXX: ignoring the rest (extension data) for now.
217             }
218             }
219 0   0       my $part_id = $self->{part_id} || '';
220 0 0         $part_id .= '.'
221             if $part_id;
222 0           my $i = 0;
223 0           @tmp = map { __PACKAGE__->new({ BODYSTRUCTURE => $_}, $part_id . ++$i) } @tmp;
  0            
224 0           $self->{multipart_type} = lc $multipart;
225 0           $self->{parts} = \@tmp;
226             } else {
227 0           $self->{type} = lc $struct->[0];
228 0           $self->{subtype} = lc $struct->[1];
229 0           my $a = $struct->[2];
230 0 0         if ($a) {
231 0           __lc_key_in_array($a);
232 0           my %tmp = @$a;
233 0           $self->{parameters} = \%tmp;
234             }
235 0           $self->{cid} = $struct->[3];
236 0           $self->{description} = $struct->[4];
237 0           $self->{transfer_encoding} = $struct->[5];
238 0           $self->{encoded_size} = $struct->[6];
239              
240 0 0 0       if ($self->is_message && $struct->[7] && $struct->[8]) {
    0 0        
241             # continue parsing attached message
242 0           $self->{message} = __PACKAGE__->new({
243             ENVELOPE => $struct->[7],
244             BODYSTRUCTURE => $struct->[8],
245             });
246             } elsif ($self->type ne 'text') {
247 0           $self->{md5} = $struct->[7];
248 0           my $a = $struct->[8];
249 0 0         if ($a) {
250 0           for (my $i = 0; $i < @$a; ++$i) {
251 0           $a->[$i] = lc $a->[$i];
252 0           ++$i;
253 0 0         if (ref($a->[$i]) eq 'ARRAY') {
254 0           __lc_key_in_array($a->[$i]);
255 0           my %foo = @{ $a->[$i] };
  0            
256 0           $a->[$i] = \%foo;
257             }
258             }
259 0           my %tmp = @$a;
260 0           $self->{disposition} = \%tmp;
261             }
262 0           $self->{language} = $struct->[9];
263             }
264             }
265             }
266              
267             sub __lc_key_in_array {
268 0     0     my ($a) = @_;
269 0           for (my $i = 0; $i < @$a; $i += 2) {
270 0           $a->[$i] = lc $a->[$i];
271             }
272             }
273              
274             sub _parse_envelope {
275 0     0     my ($self, $struct) = @_;
276 0           $self->{date} = $struct->[0];
277 0           $self->{subject} = $struct->[1];
278 0           $self->{from} = _parse_address($struct->[2]);
279 0           $self->{sender} = _parse_address($struct->[3]);
280 0           $self->{reply_to} = _parse_address($struct->[4]);
281 0           $self->{to} = _parse_address($struct->[5]);
282 0           $self->{cc} = _parse_address($struct->[6]);
283 0           $self->{bcc} = _parse_address($struct->[7]);
284 0           $self->{in_reply_to} = $struct->[8];
285 0           $self->{message_id} = $struct->[9];
286             }
287              
288             sub _parse_address {
289 0     0     my ($adr) = @_;
290 0 0         if ($adr) {
291 0           $adr = [ map { Net::IMAP::Client::MsgAddress->new($_) } @$adr ];
  0            
292             }
293 0           return $adr;
294             }
295              
296             1;
297              
298             __END__