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";
}
[download]