]>
Commit | Line | Data |
---|---|---|
82af6c12 MG |
1 | package App::Lastmsg; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
7 | use Config::Auto; | |
8 | $Config::Auto::DisablePerl = 1; | |
9 | use Date::Parse; | |
10 | use Email::Folder; | |
11 | use List::Util qw/max/; | |
12 | use POSIX qw/strftime/; | |
13 | ||
14 | our $OUTPUT_FILEHANDLE = \*STDOUT; | |
187045cf | 15 | our $VERSION = '0.001002'; |
82af6c12 | 16 | |
e28b3c39 MG |
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}; | |
82af6c12 | 20 | |
8d772799 MG |
21 | sub format_time { strftime '%c', localtime shift } |
22 | ||
82af6c12 MG |
23 | sub run { |
24 | my $config = Config::Auto->new(format => 'yaml')->parse; | |
25 | die "No configuration file found\n" unless $config; | |
26 | die "No addresses to track listed in config\n" unless $config->{track}; | |
27 | ||
28 | $config->{inbox} //= []; | |
29 | $config->{sent} //= []; | |
30 | $config->{inbox} = [$config->{inbox}] unless ref $config->{inbox}; | |
31 | $config->{sent} = [$config->{sent}] unless ref $config->{sent}; | |
32 | $config->{inbox} = \@DEFAULT_INBOX unless @{$config->{inbox}}; | |
33 | ||
34 | my %track = %{$config->{track}}; | |
35 | my %addr_to_id = map { | |
36 | my $id = $_; | |
37 | my $track = $track{$id}; | |
38 | $track = [$track] unless ref $track; | |
39 | map { $_ => $id } @$track | |
40 | } keys %track; | |
41 | ||
42 | my (%lastmsg, %lastaddr); | |
43 | ||
44 | my $process_message = sub { | |
45 | my ($msg, @people) = @_; | |
46 | for my $addr (@people) { | |
47 | ($addr) = $addr =~ /<\s*(.+)\s*>/ if $addr =~ /</; | |
48 | $addr =~ s/^\s+//; | |
49 | $addr =~ s/\s+$//; | |
50 | my $id = $addr_to_id{$addr}; | |
51 | next unless $id; | |
52 | my $date = str2time $msg->header_raw('Date'); | |
53 | if (!exists $lastmsg{$id} || $lastmsg{$id} < $date) { | |
54 | $lastmsg{$id} = $date; | |
55 | $lastaddr{$id} = $addr; | |
56 | } | |
57 | } | |
58 | }; | |
59 | ||
60 | for my $folder (@{$config->{inbox}}) { | |
61 | next unless -e $folder; | |
45e63402 | 62 | say STDERR "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG}; |
82af6c12 MG |
63 | my $folder = Email::Folder->new($folder); |
64 | while (my $msg = $folder->next_message) { | |
65 | my ($from) = grep { /^from$/i } $msg->header_names; | |
66 | $from = $msg->header_raw($from); | |
67 | if ($ENV{LASTMSG_DEBUG}) { | |
68 | my $mid = grep { /^message-id$/i } $msg->header_names; | |
45e63402 | 69 | say STDERR 'Processing ', $msg->header_raw('Message-ID'), |
82af6c12 MG |
70 | " from $from" if $ENV{LASTMSG_DEBUG}; |
71 | } | |
72 | $process_message->($msg, $from); | |
73 | } | |
74 | } | |
75 | ||
76 | for my $folder (@{$config->{sent}}) { | |
77 | next unless -e $folder; | |
45e63402 | 78 | say STDERR "Scanning $folder (sent)" if $ENV{LASTMSG_DEBUG}; |
82af6c12 MG |
79 | my $folder = Email::Folder->new($folder); |
80 | while (my $msg = $folder->next_message) { | |
81 | my @hdrs = grep { /^(?:to|cc|bcc)$/i } $msg->header_names; | |
82 | my @people; | |
83 | for my $hdr (@hdrs) { | |
84 | @people = (@people, split /,/, $msg->header_raw($hdr)); | |
85 | } | |
86 | if ($ENV{LASTMSG_DEBUG}) { | |
87 | my $mid = grep { /^message-id$/i } $msg->header_names; | |
45e63402 | 88 | say STDERR 'Processing ', $msg->header_raw($mid), |
82af6c12 MG |
89 | ' sent to ', join ',', @people if $ENV{LASTMSG_DEBUG}; |
90 | } | |
91 | $process_message->($msg, @people); | |
92 | } | |
93 | } | |
94 | ||
95 | my $idlen = max map { length } keys %track; | |
96 | my $addrlen = max map { length } values %lastaddr; | |
97 | ||
98 | for (sort { $lastmsg{$b} <=> $lastmsg{$a} } keys %lastmsg) { | |
8d772799 | 99 | my $time = format_time $lastmsg{$_}; |
82af6c12 MG |
100 | printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s %s\n", $_, $lastaddr{$_}, $time; |
101 | } | |
102 | ||
103 | for (grep { !exists $lastmsg{$_} } sort keys %track) { | |
104 | printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s NOT FOUND\n", $_, '' | |
105 | } | |
106 | } | |
107 | ||
108 | 1; | |
109 | __END__ | |
110 | ||
111 | =encoding utf-8 | |
112 | ||
113 | =head1 NAME | |
114 | ||
115 | App::Lastmsg - last(1) semblance for your inbox | |
116 | ||
117 | =head1 SYNOPSIS | |
118 | ||
119 | use App::Lastmsg; | |
120 | App::Lastmsg::run | |
121 | ||
122 | =head1 DESCRIPTION | |
123 | ||
124 | This module contains the implementation of the L<lastmsg(1)> script. | |
125 | See that script's documentation for information on what it does. | |
126 | ||
127 | =head1 SEE ALSO | |
128 | ||
129 | L<lastmsg> | |
130 | ||
131 | =head1 AUTHOR | |
132 | ||
133 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
134 | ||
135 | =head1 COPYRIGHT AND LICENSE | |
136 | ||
137 | Copyright (C) 2016 by Marius Gavrilescu | |
138 | ||
139 | This library is free software; you can redistribute it and/or modify | |
140 | it under the same terms as Perl itself, either Perl version 5.24.1 or, | |
141 | at your option, any later version of Perl 5 you may have available. | |
142 | ||
143 | ||
144 | =cut |