lib/App/Lastmsg.pm

   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;
  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         my $config = Config::Auto->new(format => 'yaml')->parse;
  24         die "No configuration file found\n" unless $config;
  25         die "No addresses to track listed in config\n" unless $config->{track};
  26
  27         $config->{inbox} //= [];
  28         $config->{sent}  //= [];
  29         $config->{inbox} = [$config->{inbox}] unless ref $config->{inbox};
  30         $config->{sent}  = [$config->{sent}]  unless ref $config->{sent};
  31         $config->{inbox} = \@DEFAULT_INBOX unless @{$config->{inbox}};
  32
  33         my %track = %{$config->{track}};
  34         my %addr_to_id = map {
  35                 my $id = $_;
  36                 my $track = $track{$id};
  37                 $track = [$track] unless ref $track;
  38                 map { $_ => $id } @$track
  39         } keys %track;
  40
  41         my (%lastmsg, %lastaddr);
  42
  43         my $process_message = sub {
  44                 my ($msg, @people) = @_;
  45                 for my $addr (@people) {
  46                         ($addr) = $addr =~ /<\s*(.+)\s*>/ if $addr =~ /</;
  47                         $addr =~ s/^\s+//;
  48                         $addr =~ s/\s+$//;
  49                         my $id = $addr_to_id{$addr};
  50                         next unless $id;
  51                         my $date = str2time $msg->header_raw('Date');
  52                         if (!exists $lastmsg{$id} || $lastmsg{$id} < $date) {
  53                                 $lastmsg{$id} = $date;
  54                                 $lastaddr{$id} = $addr;
  55                         }
  56                 }
  57         };
  58
  59         for my $folder (@{$config->{inbox}}) {
  60                 next unless -e $folder;
  61                 say "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG};
  62                 my $folder = Email::Folder->new($folder);
  63                 while (my $msg = $folder->next_message) {
  64                         my ($from) = grep { /^from$/i } $msg->header_names;
  65                         $from = $msg->header_raw($from);
  66                         if ($ENV{LASTMSG_DEBUG}) {
  67                                 my $mid = grep { /^message-id$/i } $msg->header_names;
  68                                 say 'Processing ', $msg->header_raw('Message-ID'),
  69                                   " from $from" if $ENV{LASTMSG_DEBUG};
  70                         }
  71                         $process_message->($msg, $from);
  72                 }
  73         }
  74
  75         for my $folder (@{$config->{sent}}) {
  76                 next unless -e $folder;
  77                 say "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 'Processing ', $msg->header_raw($mid),
  88                                   ' sent to ', join ',', @people if $ENV{LASTMSG_DEBUG};
  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 = strftime '%c', localtime $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
 107 1;
 108 __END__
 109
 110 =encoding utf-8
 111
 112 =head1 NAME
 113
 114 App::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
 123 This module contains the implementation of the L<lastmsg(1)> script.
 124 See that script's documentation for information on what it does.
 125
 126 =head1 SEE ALSO
 127
 128 L<lastmsg>
 129
 130 =head1 AUTHOR
 131
 132 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 133
 134 =head1 COPYRIGHT AND LICENSE
 135
 136 Copyright (C) 2016 by Marius Gavrilescu
 137
 138 This library is free software; you can redistribute it and/or modify
 139 it under the same terms as Perl itself, either Perl version 5.24.1 or,
 140 at your option, any later version of Perl 5 you may have available.
 141
 142
 143 =cut