File Coverage

blib/lib/App/Lastmsg.pm
Criterion Covered Total %
statement 94 95 98.9
branch 24 30 80.0
condition 5 7 71.4
subroutine 10 11 90.9
pod 0 1 0.0
total 133 144 92.3


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