File Coverage

blib/lib/Mail/POP3/Folder/maildir.pm
Criterion Covered Total %
statement 6 131 4.5
branch 0 22 0.0
condition 0 3 0.0
subroutine 2 19 10.5
pod 15 15 100.0
total 23 190 12.1


line stmt bran cond sub pod time code
1             package Mail::POP3::Folder::maildir;
2              
3             our @ISA = qw(Mail::POP3::Folder);
4              
5 4     4   31 use strict;
  4         10  
  4         124  
6 4     4   21 use Fcntl ':flock';
  4         24  
  4         6584  
7              
8             my $CRLF = "\015\012";
9              
10             sub new {
11 0     0 1   my ($class, $user_name, $password, $user_id, $maildir) = @_;
12 0           my $self = {};
13 0           bless $self, $class;
14 0           $self->{CLIENT_USER_ID} = $user_id;
15 0           $self->{MAILDIR} = $maildir;
16 0           $self->{MESSAGECNT} = 0;
17 0           $self->{MSG2OCTETS} = {};
18 0           $self->{MSG2UIDL} = {};
19 0           $self->{TOTALOCTETS} = 0;
20 0           $self->{DELETE} = {};
21 0           $self->{DELMESSAGECNT} = 0;
22 0           $self->{DELTOTALOCTETS} = 0;
23 0           $self;
24             }
25              
26             # class method
27             sub find_maildir {
28 0     0 1   my ($class, $user_name) = @_;
29 0           my $maildir;
30 0           my $home = (getpwnam $user_name)[7];
31 0           local *QMAIL;
32 0 0         if (open QMAIL, "$home/.qmail") {
33 0           $maildir = ;
34 0           close QMAIL;
35 0           chomp $maildir;
36 0           $maildir =~ s#/$##;
37 0           $maildir =~ s#^\.##;
38 0           $maildir =~ s#^/##;
39 0           $maildir = "$home/$maildir";
40             } else {
41 0           $maildir = "$home/Maildir";
42             }
43 0           $maildir;
44             }
45              
46             sub uidl_list {
47 0     0 1   my ($self, $output_fh) = @_;
48 0           for (1..$self->{MESSAGECNT}) {
49 0           $self->lock_refresh;
50 0 0         if (!$self->is_deleted($_)) {
51 0           $output_fh->print("$_ $self->{MSG2UIDL}->{$_}$CRLF");
52             }
53             }
54 0           $output_fh->print(".$CRLF");
55             }
56              
57             # find relevant info about available messages
58             sub _list_messages {
59 0     0     my $self = shift;
60 0           local *MAILDIR;
61 0           opendir MAILDIR, "$self->{MAILDIR}/new";
62 0           $self->{MAILDIR_FILES} = [ sort grep !/^\./, readdir MAILDIR ];
63 0           closedir MAILDIR;
64             # Get the number and size of messages in a Maildir mailbox
65 0           my $cnt = 0;
66 0           foreach (@{ $self->{MAILDIR_FILES} }) {
  0            
67 0           $cnt++;
68             # check/create the unique ID code
69 0           my $file = "$self->{MAILDIR}/new/$_";
70 0           my $octets = -s $file;
71 0           $self->{MSG2OCTETS}->{$cnt} = $octets;
72 0           $self->{MSG2UIDL}->{$cnt} = $_;
73 0           $self->{TOTALOCTETS} += $octets;
74             }
75 0           $self->{MESSAGECNT} = $cnt;
76             }
77              
78             # takes a message-number, which starts from 1
79             sub _msg2filename {
80 0     0     my ($self, $msg) = @_;
81 0           "$self->{MAILDIR}/new/$self->{MAILDIR_FILES}->[$msg - 1]";
82             }
83              
84             # Slightly paranoid mailbox locking...
85             sub lock_acquire {
86 0     0 1   my $self = shift;
87 0 0         if (-f "$self->{MAILDIR}/new/.mpopd.lock") {
88 0           die "Maildir/new lockfile already exists... :|(";
89             }
90 0           local *MAILDIRLOCK;
91 0           open MAILDIRLOCK, ">$self->{MAILDIR}/new/.mpopd.lock";
92 0 0         unless (flock MAILDIRLOCK, LOCK_EX|LOCK_NB) {
93 0           unlink "$self->{MAILDIR}/new/.mpopd.lock";
94 0           return 0;
95             }
96 0           $self->{LOCK_FH} = \*MAILDIRLOCK;
97 0           $self->_list_messages;
98             }
99              
100             sub is_valid {
101 0     0 1   my ($self, $msg) = @_;
102 0           $self->lock_refresh;
103 0 0 0       $msg > 0 and $msg <= $self->{MESSAGECNT} and !$self->is_deleted($msg);
104             }
105              
106             sub lock_release {
107 0     0 1   my $self = shift;
108 0           eval { $self->{LOCK_FH}->close; };
  0            
109 0           unlink "$self->{MAILDIR}/new/.mpopd.lock";
110             }
111              
112             # $message starts at 1
113             sub retrieve {
114 0     0 1   my ($self, $message, $output_fh, $mbox_destined) = @_;
115             # $self->{MAILDIR} is the full /path/file and starts at 0 !
116 0           local *MSG;
117 0           open MSG, "$self->{MAILDIR}/new/$self->{MAILDIR_FILES}->[$message - 1]";
118 0           while () {
119 0           chomp;
120             # byte-stuff lines starting with .
121 0 0         s/^\./\.\./o unless $mbox_destined;
122 0 0         my $line = $mbox_destined ? "$_\n" : "$_$CRLF";
123 0           $output_fh->print($line);
124 0           $self->lock_update;
125             }
126 0           close MSG;
127             }
128              
129             # $message starts at 1
130             # returns number of bytes
131             sub top {
132 0     0 1   my ($self, $message, $output_fh, $body_lines) = @_;
133 0           my $top_bytes = 0;
134 0           local *MSG;
135 0           open MSG, $self->_msg2filename($message);
136             # print the headers
137 0           while () {
138 0           chomp;
139 0           $self->lock_update;
140 0           my $out = "$_$CRLF";
141 0           $output_fh->print($out);
142 0           $top_bytes += length($out);
143 0 0         last if /^\s+$/;
144             }
145 0           my $cnt = 0;
146             # print the TOP arg number of body lines
147 0           while () {
148 0           ++$cnt;
149 0 0         last if $cnt > $body_lines;
150             # byte-stuff lines starting with .
151 0           s/^\./\.\./o;
152 0           $self->lock_update;
153 0           chomp;
154 0           my $out = "$_$CRLF";
155 0           $output_fh->print($out);
156 0           $top_bytes += length($out);
157             }
158 0           close MSG;
159 0           $output_fh->print(".$CRLF");
160 0           $top_bytes;
161             }
162              
163             sub is_deleted {
164 0     0 1   my ($self, $message) = @_;
165 0           return $self->{DELETE}->{$message};
166             }
167              
168             sub delete {
169 0     0 1   my ($self, $message) = @_;
170 0           $self->lock_refresh;
171 0           $self->{DELETE}->{$message} = 1;
172 0           $self->{DELMESSAGECNT} += 1;
173 0           $self->{DELTOTALOCTETS} += $self->{OCTETS}->{$message};
174             }
175              
176             sub flush_delete {
177 0     0 1   my $self = shift;
178 0           for (1..$self->{MESSAGECNT}) {
179 0 0         if ($self->{MAILBOX}->is_deleted($_)) {
180 0           unlink $self->_msg2filename($_);
181             }
182             }
183             }
184              
185             sub reset {
186 0     0 1   my $self = shift;
187 0           $self->lock_refresh;
188 0           $self->{DELETE} = {};
189 0           $self->{DELMESSAGECNT} = 0;
190 0           $self->{DELTOTALOCTETS} = 0;
191             }
192              
193             sub octets {
194 0     0 1   my ($self, $message) = @_;
195 0 0         if (defined $message) {
196 0           $self->{MSG2OCTETS}->{$message};
197             } else {
198 0           $self->{TOTALOCTETS} - $self->{DELTOTALOCTETS};
199             }
200             }
201              
202             sub messages {
203 0     0 1   my ($self) = @_;
204 0           $self->{MESSAGECNT} - $self->{DELMESSAGECNT};
205             }
206              
207             sub uidl {
208 0     0 1   my ($self, $message) = @_;
209 0           $self->{MSG2UIDL}->{$message};
210             }
211              
212             1;
213              
214             __END__