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