On windows and using the SAPI voice this program will use the system default voice: you can modify it under control panel -> Speech recognition -> properties (or somthing like that.. you can figure it).
use strict;
use warnings;
use Mail::IMAPClient;
use Term::ReadKey;
use Getopt::Long;
use Encode qw(decode encode);
use Win32::SAPI5;
use utf8;
my $VERSION = 5;
my $user;
my $server;
my $port;
my $ssl = 0;
my $imap_folder = "INBOX";
my $sleep = 60;
my $debug = 0;
my $substr = 500; # used to cut body_string
my %seen; # take count of already seen messages
my $voice = Win32::SAPI5::SpVoice->new();
$|++;
GetOptions (
"u|user=s" => \$user,
"s|server=s" => \$server,
"p|porta=i" => \$port,
"ssl=i" => \$ssl,
"f|folder=s" => \$imap_folder,
"i|interval=i" => \$sleep,
"debug" => \$debug,
"substring=i" => \$substr,
)
or show_help();
sub show_help{
print <<EOH;
$0 usage:
$0 -user LOGIN -server SERVER -port N [ -ssl 0|1 -folder FOLDER
+-interval SECONDI --substring --debug]
-u -user username to authenticate on the given server (REQU
+IRED)
-s -server IMAP server to connect to (REQUIRED)
-p -port port used by the server for IMAP connections (REQU
+IRED)
-ssl use or not SSL to connect (0 or 1 - default 1)
-f -folder IMAP folder to check (default: "INBOX")
-i -interval seconds between checks (default 60)
-substring how many bytes of mail body to print on screen (de
+fault 500)
-d -debug extra debug output
EOH
exit;
}
# check of required arguments
my %check = (user=>$user,server=>$server,port=>$port);
foreach my $need ( keys %check ){
unless ( defined $check{$need} ){
warn "\nPlease provide the parameter: $need";
show_help();
}
}
# gently ask for password
print "Enter password for $user on $server\n";
my $password;
ReadMode('noecho');
$password = ReadLine(0);
chomp $password;
ReadMode 'normal';
# the IMAP client init
my $imap = Mail::IMAPClient->new(
Server => $server,
User => $user,
password => $password,
Port => $port,
Ssl=> $ssl,
Uid=> 1,
) or die "IMAP Failure: $@";
$imap->Peek(1);# do NOT mark as read when handling messages
$imap->select( $imap_folder ) or die "IMAP Select Error for imap folde
+r [$imap_folder]: $@";
# check the connection
if ( $imap->IsConnected() ){
print "FOLDERS\n\t",join( "\n\t", $imap->folders ), "\n" if $debug
+;
voice("$user succesfully authenticated on $server port $port. ".
"Checking $imap_folder for incoming messages every $sleep seco
+nds.");
}
else{
print $imap->LastError();
die;
}
# useful to print something in cmd.exe defaulting on codepage 850
print "changing codepage..\n";
system (1, 'chcp 1252');
print "\n\nCTRL-C to exit the program permitting the IMAP logout\n";
print "CTRL-BREAK to review the current status of the program\n";
# Handle Ctrl-C
$SIG{INT} = sub{
print "\n\nLogging out..\n";
voice("IMAP logout..\n");
$imap->logout();
print "Exiting..\n";
exit;
};
# Handle Ctrl-Break
$SIG{BREAK} = sub{
print '=' x 70, "\n";
print "$0 PID $$\n";
print scalar localtime(time)," - $server ",($imap->IsConnected() ?
+ 'connected' : 'NOT connected'),"\n";
print "checked messages: ", scalar keys %seen,"\n";
print '=' x 70, "\n";
};
###################################################################
# checking for new messages infinite loop
###################################################################
my $now = time;
%seen = map { $_ => 1} $imap->sentsince($now);
while (1){
my $attempts = 1;
my $max_attempts = 12;
while ( !$imap->noop ){
print "Reconection retry $attempts..\n";
$imap->reconnect;
if( $imap->IsConnected() ){
print "Reconnected succesfully!\n";
last;
}
else{
sleep 10;
die "Impossible to reconnect: $@" if $attempts == $max_att
+empts;
$attempts++;
}
}
my @msgs = $imap->sentsince($now);
foreach my $msg (@msgs){
next if $seen{$msg};
$seen{ $msg }++;
process_message( $msg );
}
sleep 1 for 1..$sleep;
$now = time;
}
###################################################################
# handling messages
###################################################################
sub process_message{
my $msg = shift;
# extract some mail details
$imap->get_header( $msg, "From" ) =~ /^(.*)\s<(.*)>$/;
my $from_name = $1;
my $from_addr = $2;
my $subj = decode('MIME-Header', $imap->get_header( $msg, "Subjec
+t" ));
# some decoration
print '=' x 70, "\n";
print scalar localtime(time),"\n";
print '=' x 70, "\n";
#####################################
# RULES
#####################################
# Flag the message and print subj and part of the body
if(
$from_addr eq 'larry.wall@example.com' or
$subj =~ /^from larry/i
){
# say something fun
voice("Larry wrote you!");
# set the Flagged (=important, yellow star in thunderbird)
+
$imap->set_flag("Flagged",$msg);
print "SUBJECT: $subj\nBODY:\n".
# cut the body as per --substring paramenter
substr(decode('MIME-Header', $imap->body_string( $msg
+) ),0, $substr),"\n";
}
# mark as read and move it SOMEWHERE
# NOTE: this moves the message into INBOX/SOMEWHERE and if the fol
+der does not exists
# it creates it for you (you might need to 'subscribe' it in order
+ to see the message)
elsif(
$from_addr =~ /perl.org$/
){
voice("New mail from perl.org");
# mark as read
$imap->set_flag("Seen",$msg);
# move it
my $newmsgID = $imap->move( 'INBOX/SOMEWHERE', $msg )or die "C
+ould not move: $@\n";
# expunge make effective the move
$imap->expunge;
# $newmsgID must be valid
print "DEBUG: message moved\n" if $debug and $newmsgID;
}
# DEFAULT RULE
else{
voice( "Default rule. New message from: $from_name. Subject: $
+subj" );
}
# With the IMAP protocol you can manage five flags :
#
# \Seen: Message has been read
# \Answered: Message has been answered
# \Flagged: Message is marked as “flagged” for urgent/special atte
+ntion
# \Deleted: Message is marked as “to be deleted”.
# Note that the actual removal takes effect when the expunge()
+function is called,
# when you switch the mailbox, or close the connection.
# This flag is already added by the delete() function
# \Draft: Message has not completed composition (marked as a draft
+).
#
# use them as in (leading slash is optional)
# $imap->set_flag("Seen",$msg);
#
# BE AWARE: if you omit $msg like in $imap->set_flag("Seen") it wi
+ll be interpreted as $imap->set_flag("Seen", 'ALL')
# THE ABOVE IS TRUE ALSO FOR THESE METHODS:
#
# bodypart_string
# message_uid
# body_string
# get_bodystructure
# get_envelope
# fetch_hash (and so also the migrate methods)
# flags
# parse_headers
# size
#
# https://github.com/plobbes/mail-imapclient/issues/4
print '=' x 70, "\n";
}
sub voice{
my $txt = join ' ',@_;
$voice->Speak($txt);
print "VOICE: $txt\n";
}