File Coverage

blib/lib/Email/Folder/Maildir.pm
Criterion Covered Total %
statement 37 37 100.0
branch 10 16 62.5
condition 4 9 44.4
subroutine 8 8 100.0
pod 1 1 100.0
total 60 71 84.5


line stmt bran cond sub pod time code
1 1     1   6 use strict;
  1         2  
  1         34  
2 1     1   5 use warnings;
  1         3  
  1         43  
3             package Email::Folder::Maildir;
4             # ABSTRACT: reads raw RFC822 mails from a maildir
5             $Email::Folder::Maildir::VERSION = '0.859';
6 1     1   6 use Carp;
  1         2  
  1         82  
7 1     1   946 use IO::File;
  1         12434  
  1         212  
8 1     1   650 use Email::Folder::Reader;
  1         2  
  1         32  
9 1     1   820 use parent 'Email::Folder::Reader';
  1         399  
  1         6  
10              
11             #pod =head1 SYNOPSIS
12             #pod
13             #pod This isa Email::Folder::Reader - read about its API there.
14             #pod
15             #pod =head1 DESCRIPTION
16             #pod
17             #pod Does exactly what it says on the tin - fetches raw RFC822 mails from a
18             #pod maildir.
19             #pod
20             #pod The maildir format is described at
21             #pod L
22             #pod
23             #pod =cut
24              
25             sub _what_is_there {
26 1     1   5 my $self = shift;
27 1         3 my $dir = $self->{_file};
28              
29 1 50       28 croak "$dir does not exist" unless (-e $dir);
30 1 50       14 croak "$dir is not a maildir" unless (-d $dir);
31 1 50 33     32 croak "$dir is not a maildir" unless (-e "$dir/cur" && -d "$dir/cur");
32 1 50 33     35 croak "$dir is not a maildir" unless (-e "$dir/new" && -d "$dir/new");
33              
34 1         2 my @messages;
35             # ignore the tmp directory although the spec
36             # says to delete anything in tmp/ that is older than 36 hours
37 1         3 for my $sub (qw(new cur)) {
38 2 50       92 opendir(DIR,"$dir/$sub") or croak "Could not open '$dir/$sub'";
39 2         33 foreach my $file (readdir DIR) {
40 14 100       40 next if $file =~ /^\./; # as suggested by DJB
41 10         30 push @messages, "$dir/$sub/$file";
42             }
43             }
44              
45 1         6 $self->{_messages} = \@messages;
46             }
47              
48             sub next_message {
49 11     11 1 16 my $self = shift;
50 11   66     36 my $what = $self->{_messages} || $self->_what_is_there;
51              
52 11 100       51 my $file = shift @$what or return;
53 10         652 local *FILE;
54 10 50       400 open FILE, $file or croak "couldn't open '$file' for reading";
55 10         780 join '', ;
56             }
57              
58             1;
59              
60             __END__