File Coverage

blib/lib/App/Lastmsg.pm
Criterion Covered Total %
statement 88 94 93.6
branch 19 34 55.8
condition 5 7 71.4
subroutine 10 10 100.0
pod 0 1 0.0
total 122 146 83.5


line stmt bran cond sub pod time code
1             package App::Lastmsg;
2              
3 1     1   13073 use 5.014000;
  1         3  
4 1     1   4 use strict;
  1         1  
  1         21  
5 1     1   2 use warnings;
  1         5  
  1         25  
6              
7 1     1   489 use Config::Auto;
  1         3730  
  1         30  
8             $Config::Auto::DisablePerl = 1;
9 1     1   398 use Date::Parse;
  1         4499  
  1         115  
10 1     1   368 use Email::Folder;
  1         13351  
  1         26  
11 1     1   6 use List::Util qw/max/;
  1         1  
  1         72  
12 1     1   432 use POSIX qw/strftime/;
  1         4149  
  1         4  
13              
14             our $OUTPUT_FILEHANDLE = \*STDOUT;
15             our $VERSION = '0.001002';
16              
17             our @DEFAULT_INBOX = (
18             "/var/mail/$ENV{USER}",
19             "$ENV{HOME}/Maildir/",
20             );
21              
22             sub run {
23 1     1 0 729 my $config = Config::Auto->new(format => 'yaml')->parse;
24 1 50       18960 die "No configuration file found\n" unless $config;
25 1 50       4 die "No addresses to track listed in config\n" unless $config->{track};
26              
27 1   50     3 $config->{inbox} //= [];
28 1   50     3 $config->{sent} //= [];
29 1 50       5 $config->{inbox} = [$config->{inbox}] unless ref $config->{inbox};
30 1 50       4 $config->{sent} = [$config->{sent}] unless ref $config->{sent};
31 1 50       1 $config->{inbox} = \@DEFAULT_INBOX unless @{$config->{inbox}};
  1         4  
32              
33 1         2 my %track = %{$config->{track}};
  1         4  
34             my %addr_to_id = map {
35 1         2 my $id = $_;
  3         4  
36 3         3 my $track = $track{$id};
37 3 100       9 $track = [$track] unless ref $track;
38 3         2 map { $_ => $id } @$track
  4         11  
39             } keys %track;
40              
41 1         3 my (%lastmsg, %lastaddr);
42              
43             my $process_message = sub {
44 4     4   6 my ($msg, @people) = @_;
45 4         6 for my $addr (@people) {
46 5 100       21 ($addr) = $addr =~ /<\s*(.+)\s*>/ if $addr =~ /
47 5         7 $addr =~ s/^\s+//;
48 5         6 $addr =~ s/\s+$//;
49 5         8 my $id = $addr_to_id{$addr};
50 5 100       8 next unless $id;
51 4         6 my $date = str2time $msg->header_raw('Date');
52 4 100 100     872 if (!exists $lastmsg{$id} || $lastmsg{$id} < $date) {
53 3         5 $lastmsg{$id} = $date;
54 3         34 $lastaddr{$id} = $addr;
55             }
56             }
57 1         5 };
58              
59 1         2 for my $folder (@{$config->{inbox}}) {
  1         3  
60 1 50       15 next unless -e $folder;
61 1 50       4 say "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG};
62 1         9 my $folder = Email::Folder->new($folder);
63 1         13242 while (my $msg = $folder->next_message) {
64 3         731 my ($from) = grep { /^from$/i } $msg->header_names;
  18         92  
65 3         10 $from = $msg->header_raw($from);
66 3 50       56 if ($ENV{LASTMSG_DEBUG}) {
67 0         0 my $mid = grep { /^message-id$/i } $msg->header_names;
  0         0  
68             say 'Processing ', $msg->header_raw('Message-ID'),
69 0 0       0 " from $from" if $ENV{LASTMSG_DEBUG};
70             }
71 3         7 $process_message->($msg, $from);
72             }
73             }
74              
75 1         60 for my $folder (@{$config->{sent}}) {
  1         4  
76 1 50       11 next unless -e $folder;
77 1 50       2 say "Scanning $folder (sent)" if $ENV{LASTMSG_DEBUG};
78 1         5 my $folder = Email::Folder->new($folder);
79 1         1740 while (my $msg = $folder->next_message) {
80 1         258 my @hdrs = grep { /^(?:to|cc|bcc)$/i } $msg->header_names;
  6         31  
81 1         2 my @people;
82 1         2 for my $hdr (@hdrs) {
83 1         3 @people = (@people, split /,/, $msg->header_raw($hdr));
84             }
85 1 50       19 if ($ENV{LASTMSG_DEBUG}) {
86 0         0 my $mid = grep { /^message-id$/i } $msg->header_names;
  0         0  
87             say 'Processing ', $msg->header_raw($mid),
88 0 0       0 ' sent to ', join ',', @people if $ENV{LASTMSG_DEBUG};
89             }
90 1         3 $process_message->($msg, @people);
91             }
92             }
93              
94 1         35 my $idlen = max map { length } keys %track;
  3         9  
95 1         3 my $addrlen = max map { length } values %lastaddr;
  2         5  
96              
97 1         5 for (sort { $lastmsg{$b} <=> $lastmsg{$a} } keys %lastmsg) {
  1         4  
98 2         25 my $time = strftime '%c', localtime $lastmsg{$_};
99 2         74 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s %s\n", $_, $lastaddr{$_}, $time;
100             }
101              
102 1         4 for (grep { !exists $lastmsg{$_} } sort keys %track) {
  3         6  
103 1         15 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s NOT FOUND\n", $_, ''
104             }
105             }
106              
107             1;
108             __END__