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   12742 use 5.014000;
  1         15  
4 1     1   3 use strict;
  1         1  
  1         21  
5 1     1   2 use warnings;
  1         4  
  1         24  
6              
7 1     1   479 use Config::Auto;
  1         3796  
  1         53  
8             $Config::Auto::DisablePerl = 1;
9 1     1   487 use Date::Parse;
  1         4824  
  1         90  
10 1     1   373 use Email::Folder;
  1         13965  
  1         24  
11 1     1   15 use List::Util qw/max/;
  1         1  
  1         75  
12 1     1   481 use POSIX qw/strftime/;
  1         4300  
  1         4  
13              
14             our $OUTPUT_FILEHANDLE = \*STDOUT;
15             our $VERSION = '0.002';
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 1167 my $config = Config::Auto->new(format => 'yaml')->parse;
25 2 50       23190 die "No configuration file found\n" unless $config;
26 2 50       7 die "No addresses to track listed in config\n" unless $config->{track};
27              
28 2   50     6 $config->{inbox} //= [];
29 2   50     5 $config->{sent} //= [];
30 2 50       6 $config->{inbox} = [$config->{inbox}] unless ref $config->{inbox};
31 2 50       20 $config->{sent} = [$config->{sent}] unless ref $config->{sent};
32 2 50       2 $config->{inbox} = \@DEFAULT_INBOX unless @{$config->{inbox}};
  2         17  
33              
34 2         3 my %track = %{$config->{track}};
  2         8  
35             my %addr_to_id = map {
36 2         6 my $id = $_;
  6         4  
37 6         6 my $track = $track{$id};
38 6 100       9 $track = [$track] unless ref $track;
39 6         7 map { $_ => $id } @$track
  8         17  
40             } keys %track;
41              
42 2         4 my (%lastmsg, %lastaddr);
43              
44             my $process_message = sub {
45 8     8   10 my ($msg, @people) = @_;
46 8         12 for my $addr (@people) {
47 10 100       42 ($addr) = $addr =~ /<\s*(.+)\s*>/ if $addr =~ /
48 10         13 $addr =~ s/^\s+//;
49 10         14 $addr =~ s/\s+$//;
50 10         13 my $id = $addr_to_id{$addr};
51 10 100       18 next unless $id;
52 8         12 my $date = str2time $msg->header_raw('Date');
53 8 100 100     1564 if (!exists $lastmsg{$id} || $lastmsg{$id} < $date) {
54 6         25 $lastmsg{$id} = $date;
55 6         54 $lastaddr{$id} = $addr;
56             }
57             }
58 2         10 };
59              
60 2         4 for my $folder (@{$config->{inbox}}) {
  2         5  
61 4 100       133 next unless -e $folder;
62 2 100       10 say STDERR "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG};
63 2         19 my $folder = Email::Folder->new($folder);
64 2         15132 while (my $msg = $folder->next_message) {
65 6         1450 my ($from) = grep { /^from$/i } $msg->header_names;
  36         171  
66 6         15 $from = $msg->header_raw($from);
67 6 100       118 if ($ENV{LASTMSG_DEBUG}) {
68 3         6 my ($mid) = grep { /^message-id$/i } $msg->header_names;
  18         65  
69 3         9 say STDERR 'Processing ', $msg->header_raw($mid), " from $from";
70             }
71 6         68 $process_message->($msg, $from);
72             }
73             }
74              
75 2         3 for my $folder (@{$config->{sent}}) {
  2         7  
76 2 50       18 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         3657 while (my $msg = $folder->next_message) {
80 2         500 my @hdrs = grep { /^(?:to|cc|bcc)$/i } $msg->header_names;
  12         60  
81 2         3 my @people;
82 2         4 for my $hdr (@hdrs) {
83 2         4 @people = (@people, split /,/, $msg->header_raw($hdr));
84             }
85 2 100       37 if ($ENV{LASTMSG_DEBUG}) {
86 1         4 my ($mid) = grep { /^message-id$/i } $msg->header_names;
  6         23  
87 1         4 say STDERR 'Processing ', $msg->header_raw($mid),
88             ' sent to ', join ',', @people;
89             }
90 2         21 $process_message->($msg, @people);
91             }
92             }
93              
94 2         63 my $idlen = max map { length } keys %track;
  6         16  
95 2         4 my $addrlen = max map { length } values %lastaddr;
  4         16  
96              
97 2         8 for (sort { $lastmsg{$b} <=> $lastmsg{$a} } keys %lastmsg) {
  2         7  
98 4         11 my $time = format_time $lastmsg{$_};
99 4         34 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s %s\n", $_, $lastaddr{$_}, $time;
100             }
101              
102 2         5 for (grep { !exists $lastmsg{$_} } sort keys %track) {
  6         9  
103 2         38 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s NOT FOUND\n", $_, ''
104             }
105             }
106              
107             1;
108             __END__