]> iEval git - app-lastmsg.git/blame_incremental - lib/App/Lastmsg.pm
Bump version and update Changes
[app-lastmsg.git] / lib / App / Lastmsg.pm
... / ...
CommitLineData
1package App::Lastmsg;
2
3use 5.014000;
4use strict;
5use warnings;
6
7use Config::Auto;
8$Config::Auto::DisablePerl = 1;
9use Date::Parse;
10use Email::Folder;
11use List::Util qw/max/;
12use POSIX qw/strftime/;
13
14our $OUTPUT_FILEHANDLE = \*STDOUT;
15our $VERSION = '0.002001';
16
17our @DEFAULT_INBOX;
18push @DEFAULT_INBOX, "/var/mail/$ENV{USER}" if exists $ENV{USER};
19push @DEFAULT_INBOX, "$ENV{HOME}/Maildir" if exists $ENV{HOME};
20
21sub format_time { strftime '%c', localtime shift }
22
23sub 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;
62 say STDERR "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG};
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;
69 say STDERR 'Processing ', $msg->header_raw($mid), " from $from";
70 }
71 $process_message->($msg, $from);
72 }
73 }
74
75 for my $folder (@{$config->{sent}}) {
76 next unless -e $folder;
77 say STDERR "Scanning $folder (sent)" if $ENV{LASTMSG_DEBUG};
78 my $folder = Email::Folder->new($folder);
79 while (my $msg = $folder->next_message) {
80 my @hdrs = grep { /^(?:to|cc|bcc)$/i } $msg->header_names;
81 my @people;
82 for my $hdr (@hdrs) {
83 @people = (@people, split /,/, $msg->header_raw($hdr));
84 }
85 if ($ENV{LASTMSG_DEBUG}) {
86 my ($mid) = grep { /^message-id$/i } $msg->header_names;
87 say STDERR 'Processing ', $msg->header_raw($mid),
88 ' sent to ', join ',', @people;
89 }
90 $process_message->($msg, @people);
91 }
92 }
93
94 my $idlen = max map { length } keys %track;
95 my $addrlen = max map { length } values %lastaddr;
96
97 for (sort { $lastmsg{$b} <=> $lastmsg{$a} } keys %lastmsg) {
98 my $time = format_time $lastmsg{$_};
99 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s %s\n", $_, $lastaddr{$_}, $time;
100 }
101
102 for (grep { !exists $lastmsg{$_} } sort keys %track) {
103 printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s NOT FOUND\n", $_, ''
104 }
105}
106
1071;
108__END__
109
110=encoding utf-8
111
112=head1 NAME
113
114App::Lastmsg - last(1) semblance for your inbox
115
116=head1 SYNOPSIS
117
118 use App::Lastmsg;
119 App::Lastmsg::run
120
121=head1 DESCRIPTION
122
123This module contains the implementation of the L<lastmsg(1)> script.
124See that script's documentation for information on what it does.
125
126=head1 SEE ALSO
127
128L<lastmsg>
129
130=head1 AUTHOR
131
132Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
133
134=head1 COPYRIGHT AND LICENSE
135
136Copyright (C) 2016-2017 by Marius Gavrilescu
137
138This library is free software; you can redistribute it and/or modify
139it under the same terms as Perl itself, either Perl version 5.24.1 or,
140at your option, any later version of Perl 5 you may have available.
141
142
143=cut
This page took 0.02113 seconds and 4 git commands to generate.