But never knowing that the important people in your life — those you love, those who pay you, those who fix your guitars — are trying to contact you because you've turned off notifications is madness also. Perhaps a worse madness.
But Perl exists. CPAN exists. There is a way out.
I wrote a program for more general-purpose mail-handling, mostly clearing spam out of my work accounts, but decided to rewrite in order to handle the act of warning that I had new mail.
#!/home/jacoby/perl5/perlbrew/perls/perl-5.20.2/bin/perl
# specialized version of imap_task that handles just warnings.
# problem with previous attempts is that it kept warning about
# new mail that matched until it was marked it read or deleted
# the goal is to do things once, with a data store independent
# from IMAP that indicates if the warning has been sent.
# YAML? JSON? Mongo? We'll try YAML.
use feature qw'say state' ;
use strict ;
use warnings ;
use utf8 ;
use Carp ;
use DateTime ;
use DateTime::Duration ;
use DateTime::Format::DateParse ;
use Getopt::Long ;
use IO::Interactive qw{interactive} ;
use IO::Socket::SSL ;
use Mail::IMAPClient ;
use YAML::XS qw{ LoadFile DumpFile } ;
use lib '/home/jacoby/lib' ;
use Locked ;
use Notify qw{ notify } ;
use Pushover ;
use Say qw{ say_message } ;
I have gone to perlbrew for most of my usable Perl, and I would normally use
#!/usr/bin/env perl as my hashbang, but it is hard to tell crontab to use a perl other than system perl, so rather than trying, I specify the perl I want. Your usage will vary.The next four non-code lines are my standard. That's mostly
use Modern::Perl, I think, but I like being able to specify.After that, there's a bunch of modules from CPAN.
IO::Socket::SSL and Mail::IMAPClient are crucial for interacting with the mail server, YAML::XS is the better YAML module, according to Gabor Szabo. I like programs that give me verbose output when I run them, but don't clog my cron inbox when run via crontab, so I really overuse IO::Interactive. I am not sure that I need all the DateTime stuff I load for this purpose, but better safe than sorry.Then there's the stuff that I wrote for purposes such as this. I have many programs that I want to behave differently if the computer is locked, which means I'm not at my standing desk, so I wrote
Locked. I wanted to use notify-send on my Ubuntu machines to pop up notifications, so I wrote Notify. Net::Pushover wasn't written when I started this, so I wrote Pushover to interact with Pushover and should've put it on CPAN myself. Alas. And Say doesn't have to do with say(), but rather is a wrapper around eSpeak, a speech synthesizer.my @sender ;
my $debug = 0 ;
my $task ;
$task = 'work_alert' ;
GetOptions(
'debug=i' => \$debug,
# 'task=s' => \$task,
)
or exit(1) ;
# get the configuration
my $config_file = $ENV{HOME} . '/.imap/' . $task . '.yml' ;
croak 'No task set' if length $task < 1 ;
croak 'No task file' if !-f $config_file ;
my $settings = LoadFile($config_file) ;
$settings->{debug} = $debug ;
# set a message if one hasn't been set
$settings->{message} = $settings->{message} ? $settings->{message} : 'You have mail' ;
my $has_spoken = 0 ;
say {interactive} '='x20;
my $warn_file = $ENV{HOME} . '/.imap_warn.yml' ;
my $warnings = LoadFile($warn_file) ;
check_imap($settings) ;
DumpFile( $warn_file , $warnings ) ;
say {interactive} '-'x20;
exit ;
There are two YAML files that this program uses. One is .imap_warn.yml, which is a hash where the key is "$FROM||$SUBJECT||$DATE" and the value is 1, so I can tell if I've been told about a certain email before, and .imap/work_alert.yml, which is the main configuration file, and looks like this:
---
server: mailserver.example.com
port: 993
username: username
password: you_dont_get_my_password
message: 'You have mail'
folders:
INBOX:
alert:
subject:
- 'big data'
from:
# Family
- jacoby
# The Lab
- boss@example.com
I have used a separate file to hold the specifications for my SMTP and IMAP servers, but here, having all the config in one place seemed right. Since it contains password information, it is especially important that permissions are set correctly, specifically only you can read it. I do not test permissions in this program.
As mentioned, this is adapted from a more general mail-handling program, which takes specific configuration files for the kind of work it does. This just has the one, so that has been commented out, leaving just the debug flag.
I have had issues with YAML empty-writing files, which is why I separated .imap_warn from work_alert.pl.
sub check_imap {
my $settings = shift ;
my $client ;
if ( $settings->{port} == 993 ) {
my $socket = IO::Socket::SSL->new(
PeerAddr => $settings->{server},
PeerPort => $settings->{port},
)
or die "socket(): $@" ;
$client = Mail::IMAPClient->new(
Socket => $socket,
User => $settings->{username},
Password => $settings->{password},
)
or die "new(): $@" ;
}
elsif ( $settings->{port} == 587 ) {
$client = Mail::IMAPClient->new(
Server => $settings->{server},
User => $settings->{username},
Password => $settings->{password},
)
or die "new(): $@" ;
}
my $dispatch ;
$dispatch->{'alert'} = \&alert_and_store_mail ;
$dispatch->{'warn'} = \&warn_mail ;
if ( $client->IsAuthenticated() ) {
say {interactive} 'STARTING' ;
for my $folder ( keys %{ $settings->{folders} } ) {
say {interactive} join ' ', ( '+' x 5 ), $folder ;
$client->select($folder)
or die "Select '$folder' error: ",
$client->LastError, "\n" ;
my $actions = $settings->{folders}->{$folder} ;
for my $msg ( reverse $client->unseen ) {
my $from = $client->get_header( $msg, 'From' ) || '' ;
my $to = $client->get_header( $msg, 'To' ) || '' ;
my $cc = $client->get_header( $msg, 'Cc' ) || '' ;
my $subject = $client->subject($msg) || '' ;
say {interactive} 'F: ' . $from ;
say {interactive} 'S: ' . $subject ;
# say { interactive } 'T: ' . $to ;
# say { interactive } 'C: ' . $cc ;
for my $action ( keys %$actions ) {
# say { interactive } ' for action: ' . $action ;
for my $key ( @{ $actions->{$action}->{from} } ) {
if ( defined $key
&& $from =~ m{$key}i
&& $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{to} } ) {
if ( $to =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{cc} } ) {
if ( $cc =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
for my $key ( @{ $actions->{$action}->{subject} } ) {
my $match = $subject =~ m{$key}i ;
if ( $subject =~ m{$key}i && $dispatch->{$action} ) {
$dispatch->{$action}->( $client, $msg ) ;
}
}
}
say {interactive} '' ;
}
say {interactive} join ' ', ( '-' x 5 ), $folder ;
}
# $client->close() is needed to make deletes delete, put putting before the
# logout stops the process.
$client->close ;
$client->logout() ;
say {interactive} 'Finishing' ;
}
say {interactive} 'Bye' ;
}
There are four things we can match on: from, to, cc and subject. I generally match on subject and from, but the code is there.
I have started but not finished Higher Order Perl by Mark Jason Dominus, but one of the things I got from that book (I think; if not, then from co-workers) is the concept of a dispatch table, where behavior of the program changes based on the data. I could simplify this a lot more, I'm sure, with more higher-order programming, but I'm reasonably happy with it right now.
# ====================================================================
# send to STDOUT without IO::Interactive, for testing
sub warn_mail {
my ( $client, $msg ) = @_ ;
say {interactive} 'warn' ;
my $from = $client->get_header( $msg, 'From' ) || return ;
my $to = $client->get_header( $msg, 'To' ) || return ;
my $subject = $client->subject($msg) || return ;
my $date = $client->get_header( $msg, 'Date' ) || return ;
my $dt = DateTime::Format::DateParse->parse_datetime($date) ;
my $today = DateTime->now() ;
$dt->set_time_zone('UTC') ;
$today->set_time_zone('UTC') ;
my $delta = $today->delta_days($dt)->in_units('days') ;
say $from ;
say $to ;
say $subject ;
say $dt->ymd ;
say $delta ;
}
# ====================================================================
# alert about new mail
sub alert_and_store_mail {
my ( $client, $msg ) = @_ ;
say {interactive} 'alert and store' ;
my $date = $client->get_header( $msg, 'Date' ) || 'NONE' ;
my $from = $client->get_header( $msg, 'From' ) || 'NONE' ;
my $to = $client->get_header( $msg, 'To' ) || 'NONE' ;
my $subject = $client->subject($msg) || 'NONE' ;
my $key = join '||' , $from , $subject , $date ;
$key =~ s{\s+}{ }g ;
my $title = 'Mail From: ' . $from ;
chomp $title ;
chomp $subject ;
return if $warnings->{$key} ;
$warnings->{$key} = 1 ;
$from =~ s{\"}{}gx ;
if ( is_locked() ) {
pushover(
{ title => $title ,
message => $subject
}
) ;
}
else {
say {interactive} $title ;
say {interactive} $subject ;
say {interactive} defined $warnings->{$key} ? 1 : 0 ;
say {interactive} 'has spoken: ' . $has_spoken ;
if ( ! $has_spoken ) {
say_message( { message => $settings->{message} , title => '' } ) ;
}
notify(
{ title => $title ,
message => $subject ,
icon => '/home/jacoby/Dropbox/Photos/Icons/mail.png' ,
}
) ;
}
$has_spoken = 1 ;
return ;
}
warn() is useful for debugging, but the work of the program is done in alert_and_store_mail(). $client is the IMAP connection, and $msg is the message itself. I find that I have to send both. I might be doing it wrong, though.And here is where my modules come in. is_locked() returns a boolean, depending on which way you lock your screens. say_message(), pushover() and notify() share a format, a hashref containing title and message. say_message() tells me that I have notifications coming, and they show up on my desktop. And if I'm away from my desk, they show up on my tablet because of Pushover.
I'll put this into a repo on GitHub, including all the modules. I would like to get this into shape to be something like App::imap_warn or the like, but I'm not there yet. I'm sure there's interest, because default notifications suck.
No comments:
Post a Comment