[app-lastmsg.git] / Lastmsg.pm

package App::Lastmsg;

use 5.014000;
use strict;
use warnings;

use Config::Auto;
$Config::Auto::DisablePerl = 1;
use Date::Parse;
use Email::Folder;
use List::Util qw/max/;
use POSIX qw/strftime/;

our $OUTPUT_FILEHANDLE = \*STDOUT;
our $VERSION = '0.001';

our @DEFAULT_INBOX = (
	"/var/mail/$ENV{USER}",
	"$ENV{HOME}/Maildir/",
);

sub run {
	my $config = Config::Auto->new(format => 'yaml')->parse;
	die "No configuration file found\n" unless $config;
	die "No addresses to track listed in config\n" unless $config->{track};

	$config->{inbox} //= [];
	$config->{sent}  //= [];
	$config->{inbox} = [$config->{inbox}] unless ref $config->{inbox};
	$config->{sent}  = [$config->{sent}]  unless ref $config->{sent};
	$config->{inbox} = \@DEFAULT_INBOX unless @{$config->{inbox}};

	my %track = %{$config->{track}};
	my %addr_to_id = map {
		my $id = $_;
		my $track = $track{$id};
		$track = [$track] unless ref $track;
		map { $_ => $id } @$track
	} keys %track;

	my (%lastmsg, %lastaddr);

	my $process_message = sub {
		my ($msg, @people) = @_;
		for my $addr (@people) {
			($addr) = $addr =~ /<\s*(.+)\s*>/ if $addr =~ /</;
			$addr =~ s/^\s+//;
			$addr =~ s/\s+$//;
			my $id = $addr_to_id{$addr};
			next unless $id;
			my $date = str2time $msg->header_raw('Date');
			if (!exists $lastmsg{$id} || $lastmsg{$id} < $date) {
				$lastmsg{$id} = $date;
				$lastaddr{$id} = $addr;
			}
		}
	};

	for my $folder (@{$config->{inbox}}) {
		next unless -e $folder;
		say "Scanning $folder (inbox)" if $ENV{LASTMSG_DEBUG};
		my $folder = Email::Folder->new($folder);
		while (my $msg = $folder->next_message) {
			my ($from) = grep { /^from$/i } $msg->header_names;
			$from = $msg->header_raw($from);
			if ($ENV{LASTMSG_DEBUG}) {
				my $mid = grep { /^message-id$/i } $msg->header_names;
				say 'Processing ', $msg->header_raw('Message-ID'),
				  " from $from" if $ENV{LASTMSG_DEBUG};
			}
			$process_message->($msg, $from);
		}
	}

	for my $folder (@{$config->{sent}}) {
		next unless -e $folder;
		say "Scanning $folder (sent)" if $ENV{LASTMSG_DEBUG};
		my $folder = Email::Folder->new($folder);
		while (my $msg = $folder->next_message) {
			my @hdrs = grep { /^(?:to|cc|bcc)$/i } $msg->header_names;
			my @people;
			for my $hdr (@hdrs) {
				@people = (@people, split /,/, $msg->header_raw($hdr));
			}
			if ($ENV{LASTMSG_DEBUG}) {
				my $mid = grep { /^message-id$/i } $msg->header_names;
				say 'Processing ', $msg->header_raw($mid),
				  ' sent to ', join ',', @people if $ENV{LASTMSG_DEBUG};
			}
			$process_message->($msg, @people);
		}
	}

	my $idlen   = max map { length } keys %track;
	my $addrlen = max map { length } values %lastaddr;

	for (sort { $lastmsg{$b} <=> $lastmsg{$a} } keys %lastmsg) {
		my $time = strftime '%c', localtime $lastmsg{$_};
		printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s %s\n", $_, $lastaddr{$_}, $time;
	}

	for (grep { !exists $lastmsg{$_} } sort keys %track) {
		printf $OUTPUT_FILEHANDLE "%-${idlen}s %-${addrlen}s NOT FOUND\n", $_, ''
	}
}

1;
__END__

=encoding utf-8

=head1 NAME

App::Lastmsg - last(1) semblance for your inbox

=head1 SYNOPSIS

  use App::Lastmsg;
  App::Lastmsg::run

=head1 DESCRIPTION

This module contains the implementation of the L<lastmsg(1)> script.
See that script's documentation for information on what it does.

=head1 SEE ALSO

L<lastmsg>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2016 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.24.1 or,
at your option, any later version of Perl 5 you may have available.


=cut
Commit	Line	Data
	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.001';
	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