File Coverage

blib/lib/Mail/Box/IMAP4/Message.pm
Criterion Covered Total %
statement 15 94 15.9
branch 0 50 0.0
condition 0 21 0.0
subroutine 5 14 35.7
pod 6 9 66.6
total 26 188 13.8


line stmt bran cond sub pod time code
1             # Copyrights 2001-2023 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.03.
5             # This code is part of distribution Mail-Box-IMAP4. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Box::IMAP4::Message;
10 2     2   16 use vars '$VERSION';
  2         7  
  2         106  
11             $VERSION = '3.008';
12              
13 2     2   12 use base 'Mail::Box::Net::Message';
  2         4  
  2         186  
14              
15 2     2   13 use strict;
  2         5  
  2         55  
16 2     2   14 use warnings;
  2         5  
  2         66  
17              
18 2     2   955 use Date::Parse 'str2time';
  2         7045  
  2         2014  
19              
20              
21             sub init($)
22 0     0 0   { my ($self, $args) = @_;
23              
24 0           $self->SUPER::init($args);
25              
26             $self->{MBIM_write_labels}
27 0 0         = exists $args->{write_labels} ? $args->{write_labels} : 1;
28              
29 0           $self->{MBIM_cache_labels} = $args->{cache_labels};
30 0           $self->{MBIM_cache_head} = $args->{cache_head};
31 0           $self->{MBIM_cache_body} = $args->{cache_body};
32              
33 0           $self;
34             }
35              
36              
37             sub size($)
38 0     0 1   { my $self = shift;
39            
40 0 0         return $self->SUPER::size
41             unless $self->isDelayed;
42              
43 0           $self->fetch('RFC822.SIZE');
44             }
45              
46             sub recvstamp()
47 0     0 0   { my $date = shift->fetch('INTERNALDATE');
48 0 0         defined $date ? str2time($date) : undef;
49             }
50              
51              
52             sub label(@)
53 0     0 1   { my $self = shift;
54 0 0         my $imap = $self->folder->transporter or return;
55 0 0         my $id = $self->unique or return;
56              
57 0 0         if(@_ == 1)
58             { # get one value only
59 0           my $label = shift;
60 0           my $labels = $self->{MM_labels};
61             return $labels->{$label}
62 0 0 0       if exists $labels->{$label} || exists $labels->{seen};
63              
64 0           my $flags = $imap->getFlags($id);
65 0 0         if($self->{MBIM_cache_labels})
66             { # the program may have added own labels
67 0           @{$labels}{keys %$flags} = values %$flags;
  0            
68 0           delete $self->{MBIM_labels_changed};
69             }
70 0           return $flags->{$label};
71             }
72              
73 0           my @private;
74 0 0         if($self->{MBIM_write_labels})
75 0           { @private = $imap->setFlags($id, @_);
76 0           delete $self->{MBIM_labels_changed};
77             }
78             else
79 0           { @private = @_;
80             }
81              
82 0           my $labels = $self->{MM_labels};
83 0 0         my @keep = $self->{MBIM_cache_labels} ? @_ : @private;
84              
85 0           while(@keep)
86 0           { my ($k, $v) = (shift @keep, shift @keep);
87 0 0 0       next if defined $labels->{$k} && $labels->{$k} eq $v;
88              
89 0           $self->{MBIM_labels_changed}++;
90 0           $labels->{$k} = $v;
91             }
92 0 0 0       $self->modified(1) if @private && $self->{MBIM_labels_changed};
93            
94 0           $self;
95             }
96              
97              
98             sub labels()
99 0     0 1   { my $self = shift;
100 0           my $id = $self->unique;
101 0           my $labels = $self->SUPER::labels;
102 0 0         $labels = { %$labels } unless $self->{MBIM_cache_labels};
103              
104 0 0 0       if($id && !exists $labels->{seen})
105 0 0         { my $imap = $self->folder->transporter or return;
106 0           my $flags = $imap->getFlags($id);
107 0           @{$labels}{keys %$flags} = values %$flags;
  0            
108             }
109              
110 0           $labels;
111             }
112              
113             #-------------------------------------------
114              
115              
116             sub loadHead()
117 0     0 0   { my $self = shift;
118 0           my $head = $self->head;
119 0 0         return $head unless $head->isDelayed;
120              
121 0           $head = $self->folder->getHead($self);
122 0 0         $self->head($head) if $self->{MBIM_cache_head};
123 0           $head;
124             }
125              
126             sub loadBody()
127 0     0 1   { my $self = shift;
128              
129 0           my $body = $self->body;
130 0 0         return $body unless $body->isDelayed;
131              
132 0           (my $head, $body) = $self->folder->getHeadAndBody($self);
133 0 0         return undef unless defined $head;
134              
135 0 0 0       $self->head($head) if $self->{MBIM_cache_head} && $head->isDelayed;
136 0 0         $self->storeBody($body) if $self->{MBIM_cache_body};
137 0           $body;
138             }
139              
140              
141             sub fetch(@)
142 0     0 1   { my ($self, @info) = @_;
143 0           my $folder = $self->folder;
144 0           my $answer = ($folder->fetch( [$self], @info))[0];
145              
146 0 0         @info==1 ? $answer->{$info[0]} : @{$answer}{@info};
  0            
147             }
148              
149              
150             sub writeDelayed($$)
151 0     0 1   { my ($self, $foldername, $imap) = @_;
152              
153 0           my $id = $self->unique;
154 0           my $labels = $self->labels;
155              
156 0 0 0       if($self->head->modified || $self->body->modified || !$id)
    0 0        
157             {
158 0           $imap->appendMessage($self, $foldername);
159 0 0         if($id)
160 0           { $self->delete;
161 0           $self->unique(undef);
162             }
163             }
164             elsif($self->{MBIM_labels_changed})
165 0           { $imap->setFlags($id, %$labels); # non-IMAP4 labels disappear
166 0           delete $self->{MBIM_labels_changed};
167             }
168              
169 0           $self;
170             }
171              
172             #-------------------------------------------
173              
174              
175             1;