File Coverage

blib/lib/Mail/Dir/Message.pm
Criterion Covered Total %
statement 9 58 15.5
branch 0 36 0.0
condition n/a
subroutine 3 15 20.0
pod 10 12 83.3
total 22 121 18.1


line stmt bran cond sub pod time code
1             # Copyright (c) 2014 cPanel, Inc.
2             # All rights reserved.
3             # http://cpanel.net/
4             #
5             # Distributed under the terms of the MIT license. See the LICENSE file for
6             # further details.
7              
8             package Mail::Dir::Message;
9              
10 1     1   4 use strict;
  1         1  
  1         30  
11 1     1   3 use warnings;
  1         2  
  1         44  
12              
13 1     1   9 use File::Basename ();
  1         2  
  1         950  
14              
15             =head1 NAME
16              
17             Mail::Dir::Message - A message in a Maildir queue
18              
19             =head1 SYNOPSIS
20              
21             #
22             # Mark message as Draft
23             #
24             $message->mark('D');
25              
26             #
27             # Verify that message was marked as Draft
28             #
29             print "Message is a draft\n" if $message->draft;
30              
31             =head1 DESCRIPTION
32              
33             C objects represent messages delivered to a Maildir mailbox,
34             and are created queries to the mailbox as issued by the method
35             C-Emessages()>. C objects are not
36             presently meant to be instantiated directly.
37              
38             =cut
39              
40             sub from_file {
41 0     0 0   my ( $class, %args ) = @_;
42              
43 0 0         die('No Maildir object specified') unless defined $args{'maildir'};
44 0 0         die('Maildir object is of incorrect type') unless $args{'maildir'}->isa('Mail::Dir');
45 0 0         die('No mailbox specified') unless defined $args{'mailbox'};
46 0 0         die('No message filename specified') unless defined $args{'file'};
47 0 0         die('No message name specified') unless defined $args{'name'};
48 0 0         die('No stat() object provided for message') unless defined $args{'st'};
49 0 0         die('stat() object is not an ARRAY') unless ref( $args{'st'} ) eq 'ARRAY';
50              
51 0 0         if ( defined $args{'dir'} ) {
52 0 0         die('"dir" may only specify "tmp", "new" or "cur"') unless $args{'dir'} =~ /^(?:tmp|new|cur)$/;
53             }
54              
55 0           my $flags = '';
56              
57 0 0         if ( $args{'flags'} ) {
    0          
58 0           $flags = parse_flags( $args{'flags'} );
59             }
60             elsif ( $args{'name'} =~ /:(?:1,.*)2,(.*)$/ ) {
61 0           $flags = parse_flags($1);
62             }
63              
64 0           return bless {
65             'maildir' => $args{'maildir'},
66             'mailbox' => $args{'mailbox'},
67             'dir' => $args{'dir'},
68             'file' => $args{'file'},
69             'name' => $args{'name'},
70             'size' => $args{'st'}->[7],
71             'atime' => $args{'st'}->[8],
72             'mtime' => $args{'st'}->[9],
73             'ctime' => $args{'st'}->[10],
74             'flags' => $flags
75             }, $class;
76             }
77              
78             =head1 READING MESSAGES
79              
80             =over
81              
82             =item C<$message-Eopen()>
83              
84             Open the current message, returning a file handle. Will die() if any errors
85             are encountered. It is the caller's responsibility to subsequently close the
86             file handle when it is no longer required.
87              
88             =cut
89              
90             sub open {
91 0     0 1   my ($self) = @_;
92              
93 0 0         CORE::open( my $fh, '<', $self->{'file'} ) or die("Unable to open message file $self->{'file'} for reading: $!");
94              
95 0           return $fh;
96             }
97              
98             =head1 MOVING MESSAGES
99              
100             =over
101              
102             =item C<$message-Emove(I<$mailbox>)>
103              
104             Move the current message to a different Maildir++ mailbox. This operation is
105             only supported when the originating mailbox is created with Maildir++
106             extensions.
107              
108             =back
109              
110             =cut
111              
112             sub move {
113 0     0 1   my ( $self, $mailbox ) = @_;
114              
115 0 0         die('Maildir++ extensions not supported') unless $self->{'maildir'}->{'maildir++'};
116 0 0         die('Specified mailbox is same as current mailbox') if $mailbox eq $self->{'maildir'}->{'mailbox'};
117              
118 0           my $mailbox_dir = $self->{'maildir'}->mailbox_dir($mailbox);
119 0           my $new_file = "$mailbox_dir/cur/$self->{'name'}:2,$self->{'flags'}";
120              
121 0 0         unless ( rename( $self->{'file'}, $new_file ) ) {
122 0           die("Unable to rename() $self->{'file'} to $new_file: $!");
123             }
124              
125 0           $self->{'file'} = $new_file;
126              
127 0           return $self;
128             }
129              
130             sub parse_flags {
131 0     0 0   my ($flags) = @_;
132 0           my $ret = '';
133              
134 0 0         die('Invalid flags') unless $flags =~ /^[PRSTDF]*$/;
135              
136 0           foreach my $flag (qw(D F P R S T)) {
137 0 0         $ret .= $flag if index( $flags, $flag ) >= 0;
138             }
139              
140 0           return $ret;
141             }
142              
143             =head1 SETTING MESSAGE FLAGS
144              
145             =over
146              
147             =item C<$message-Emark(I<$flags>)>
148              
149             Set any of the following message status flags on the current message. More
150             than one flag may be specified in a single call, in any order.
151              
152             =over
153              
154             =item * C

155              
156             Mark the message as "Passed".
157              
158             =item * C
159              
160             Mark the message as "Replied".
161              
162             =item * C
163              
164             Mark the message as "Seen".
165              
166             =item * C
167              
168             Mark the message as "Trashed".
169              
170             =item * C
171              
172             Mark the message as a "Draft".
173              
174             =item * C
175              
176             Mark the message as "Flagged".
177              
178             =back
179              
180             =back
181              
182             =cut
183              
184             sub mark {
185 0     0 1   my ( $self, $flags ) = @_;
186 0           $flags = parse_flags($flags);
187              
188 0           my $mailbox_dir = $self->{'maildir'}->mailbox_dir( $self->{'mailbox'} );
189 0           my $new_file = "$mailbox_dir/cur/$self->{'name'}:2,$flags";
190              
191 0 0         unless ( rename( $self->{'file'}, $new_file ) ) {
192 0           die("Unable to rename() $self->{'file'} to $new_file: $!");
193             }
194              
195 0           $self->{'file'} = $new_file;
196 0           $self->{'flags'} = $flags;
197              
198 0           return $self;
199             }
200              
201             =head1 CHECKING MESSAGE STATE
202              
203             The following methods can be used to quickly check for specific message state
204             flags.
205              
206             =over
207              
208             =item C<$message-Eflags()>
209              
210             Returns a string containing all the flags set for the current message.
211              
212             =cut
213              
214             sub flags {
215 0     0 1   shift->{'flags'};
216             }
217              
218             =item C<$message-Epassed()>
219              
220             Returns 1 if the message currently has the "Passed" flag set.
221              
222             =cut
223              
224             sub passed {
225 0     0 1   shift->{'flags'} =~ /P/;
226             }
227              
228             =item C<$message-Ereplied()>
229              
230             Returns 1 if the message has been replied to.
231              
232             =cut
233              
234             sub replied {
235 0     0 1   shift->{'flags'} =~ /R/;
236             }
237              
238             =item C<$message-Eseen()>
239              
240             Returns 1 if a client has read the current message.
241              
242             =cut
243              
244             sub seen {
245 0     0 1   shift->{'flags'} =~ /S/;
246             }
247              
248             =item C<$message-Etrashed()>
249              
250             Returns 1 if the message is currently trashed after one helluva wild night with
251             its best buds.
252              
253             =cut
254              
255             sub trashed {
256 0     0 1   shift->{'flags'} =~ /T/;
257             }
258              
259             =item C<$message-Edraft()>
260              
261             Returns 1 if the message is a draft.
262              
263             =cut
264              
265             sub draft {
266 0     0 1   shift->{'flags'} =~ /D/;
267             }
268              
269             =item C<$message-Eflagged()>
270              
271             Returns 1 if the message is flagged as important.
272              
273             =cut
274              
275             sub flagged {
276 0     0 1   shift->{'flags'} =~ /F/;
277             }
278              
279             =back
280              
281             =cut
282              
283             1;
284              
285             __END__