#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;
use Net::POP3;
use Pod::Usage;
use Term::ReadLine;
use Term::ANSIColor qw(:constants);
$Term::ANSIColor::AUTORESET = 1;
use Carp;

use vars qw(
    $VERSION
    $opt_verbose
    $opt_host
    $opt_username
    $opt_password
    $opt_port
    $opt_noprompt
    $opt_stdin
    $opt_timeout
    $opt_help
    $opt_version
    $pop3
);
$VERSION = sprintf '%d.%02d', q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;

$opt_port    = 110;
$opt_timeout = 120;
GetOptions(
    'v|verbose'    => \$opt_verbose,
    'h|host=s'     => \$opt_host,
    'u|username=s' => \$opt_username,
    'p|password=s' => \$opt_password,
    'noprompt'     => \$opt_noprompt,
    'timeout=i'    => \$opt_timeout,
    'port=s'       => \$opt_port,
    'stdin'        => \$opt_stdin,
    'help'         => \$opt_help,
    'version'      => \$opt_version,
) or pod2usage(2);
pod2usage(1) if $opt_help;
if ($opt_version) {
    print <<VERSION;
pop3dele, version $VERSION
Written by Michael Nachbaur <mike\@nachbaur.com>.

Copyright (c) 2002-2003 Michael A Nachbaur. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
VERSION
    exit(0);
}

unless ($opt_noprompt) {
    my $term = new Term::ReadLine::Gnu 'pop3list';
    my $attribs = $term->Attribs;
    $term->ReadHistory;
    Term::ReadLine::Gnu->Features->{ornaments} = 0;
    Term::ReadLine::Gnu->Features->{autohistory} = 0;
    my $OUT = $term->OUT || *STDOUT;
    unless ($opt_host) {
        $opt_host = $term->readline("Hostname: ");
    }
    unless ($opt_username) {
        $opt_username = $term->readline("Username: ");
    }
    unless ($opt_password) {
        $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
        $opt_password = $term->readline("Password: ");
        $term->remove_history($term->where_history);
    }
    $term->WriteHistory;
}

my $message_count = undef;
($pop3, $message_count) = pop_connect(
    username => $opt_username,
    password => $opt_password,
    host     => $opt_host,
    port     => $opt_port,
    timeout  => $opt_timeout,
) or carp "Could not get connect to the mail server.\n";

if ($#ARGV < 0 or $opt_stdin) {
    if (test_interactive()) {
        print STDERR "Enter the message IDs you want to delete, followed by \na carriage return.  Press CTRL-D to finish.\n";
        print STDERR "$message_count messages in this mailbox.\n";
    }
    while (my $line = <STDIN>) {
        chomp $line;
        if (test_interactive() and $line =~ /\s*all\s*/i) {
            print STDERR "The \"all\" keyword is not available in STDIN mode.\n";
            next;
        }
        processMessages($line);
    }
} else {
    if ($#ARGV == 0 and lc($ARGV[0]) eq 'all') {
        my $list = $pop3->list;
        foreach my $id (keys %{$list}) {
            deleteMessage($id);
        }
    } else {
        foreach my $id (@ARGV) {
            processMessages($id);
        }
    }
}

$pop3->quit();

sub processMessages {
    my ($id) = @_;

    if ($id =~ /^\s*(\d+)\s*$/) {
        my $message = $1;
        deleteMessage($message);
    } elsif ($id =~ /^\s*(\d+)-(\d+)\s*$/ and $1 < $2) {
        foreach my $message ($1 .. $2) {
            deleteMessage($message);
        }
    }
}

sub deleteMessage {
    my ($id) = @_;
    print STDERR YELLOW "Deleting #$id\n" if $opt_verbose;
    $pop3->delete($id) or print STDERR RED "Cannot delete message #$id\n";
}

sub pop_connect {
    my (%params) = @_;
    my $res = undef;
    my $num_messages = undef;

    print STDERR GREEN "Opening POP3 connectionn to $params{host}.\n" if ($opt_verbose);
    my $pop = Net::POP3->new($params{host}, Timeout => $params{timeout});

    print STDERR GREEN "Sending USER command.\n" if ($opt_verbose);
    $res = $pop->user( $params{username} );
    unless ($res) {
        print STDERR RED "Username rejected\n";
        return 0;
    }

    print STDERR GREEN "Sending PASS command.\n" if ($opt_verbose);
    $res = $pop->pass( $params{password} );
    unless ($res) {
        print STDERR RED "Password rejected\n";
        return 0;
    } else {
        ($num_messages) = $res =~ /^(\d+)/;
    }
    print STDERR CYAN "This mailbox contains $num_messages messages.\n" if ($opt_verbose);

    return ($pop, $num_messages);
}

sub test_interactive {
    return -t STDIN && -t STDOUT;
}

1;
__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

pop3dele - Deletes the specified messages from a POP3 account

=head1 OSNAMES

Any Unix-like only

=head1 SCRIPT CATEGORIES

UNIX/System_administration
Mail

=head1 PREREQUISITES

This script requires the C<Getopt::Long>, C<Pod::Usage> and C<Carp> packages, which
should be on your system anyway.  Additionally, C<Term::ReadLine> and C<Term::ANSIColor>
are used to print pretty verbose messages, so you can differentiate between local message
and server-side mail.  Finally, the magic behind this package is thanks to C<Net::POP3>,
which is required.

=head1 SYNOPSIS

  pop3dele [OPTIONS] <message numbers>

  Options:
    -v, --verbose    be verbose about what's happening
    -h, --host       hostname of POP server
    -u, --username   pop3 username
    -p, --password   password
        --noprompt   do not prompt for information
        --stdin      force the use of STDIN only
        --port       override the TCP port (default: 110)
        --timeout    response timeout in secs (default: 120)
        --help       this help screen
        --version    version  information

=head1 DESCRIPTION

pop3dele is a simple script that connects to a POP3 server and
deletes the indicated messages, by message number.  It accepts
message numbers on the command line, or through STDIN.

You have some flexibility in the message-ids that are accepted.
The keywords "all" will delete all messages on a POP3 account, but
this will only work if this is the only message ID argument provided.

Message ID numbers can be given in ranges as well, like "5-22",
but there must be no spaces between the two numbers.

=head1 README

pop3dele is a simple script that connects to a POP3 server and
deletes the indicated messages, by message number.  It accepts
message numbers on the command line, or through STDIN.

You have some flexibility in the message-ids that are accepted.
The keywords "all" will delete all messages on a POP3 account, but
this will only work if this is the only message ID argument provided.

Message ID numbers can be given in ranges as well, like "5-22",
but there must be no spaces between the two numbers.

=head1 AUTHOR

Michael A Nachbaur, E<lt>mike@nachbaur.comE<gt>

=head1 COPYRIGHT

Copyright (c) 2002-2003 Michael A Nachbaur. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 SEE ALSO

L<pop3list>, L<pop3retr>.

=head1 REVISION

$Id: pop3dele,v 1.2 2003/09/10 17:44:54 nachbaur Exp $

=cut