<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/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 POSIX qw/getpgrp tcgetpgrp/;

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

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

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-&gt;Attribs;
    $term-&gt;ReadHistory;
    Term::ReadLine::Gnu-&gt;Features-&gt;{ornaments} = 0;
    Term::ReadLine::Gnu-&gt;Features-&gt;{autohistory} = 0;
    my $OUT = $term-&gt;OUT || *STDOUT;
    unless ($opt_host) {
        $opt_host = $term-&gt;readline("Hostname: ");
    }
    unless ($opt_username) {
        $opt_username = $term-&gt;readline("Username: ");
    }
    unless ($opt_password) {
        $attribs-&gt;{redisplay_function} = $attribs-&gt;{shadow_redisplay};
        $opt_password = $term-&gt;readline("Password: ");
        $term-&gt;remove_history($term-&gt;where_history);
    }
    $term-&gt;WriteHistory;
}

exit(1) unless defined($opt_username) or defined($opt_password) or defined($opt_host);
my $messagehash = list_mailbox(
    username =&gt; $opt_username,
    password =&gt; $opt_password,
    host     =&gt; $opt_host,
    port     =&gt; $opt_port,
    timeout  =&gt; $opt_timeout,
) or carp "Could not get listing for this mail account.\n";

unless (ref($messagehash) eq 'HASH') {
    die("Message listing failed\n");
}
if ($opt_summary) {
    print scalar(keys(%{$messagehash})) . "\n";
} else {
    if (test_interactive()) {
        print "MSG#\tSize\n-------------------\n";
    }
    foreach my $key (sort {$a &lt;=&gt; $b} keys %{$messagehash}) {
        print "$key\t$messagehash-&gt;{$key}\n";
    }
}

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

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

    print STDERR GREEN "Sending USER command.\n" if ($opt_verbose);
    $res = $pop-&gt;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-&gt;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);

    print STDERR GREEN "Sending LIST command.\n" if ($opt_verbose);
    $res = $pop-&gt;list;
    unless ($res) {
        print STDERR RED "LIST command failed\n";
        return 0;
    } else {
        $message_list = $res;
    }

    print STDERR GREEN "Sending QUIT command.\n" if ($opt_verbose);
    $res = $pop-&gt;quit();
    unless ($res) {
        print STDERR RED "Logout rejected\n";
        return 0;
    }
    return $message_list;
}

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

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

=head1 NAME

pop3list - Connects to a POP3 account and lists the messages therein

=head1 OSNAMES

Any Unix-like only

=head1 SCRIPT CATEGORIES

UNIX/System_administration
Mail

=head1 PREREQUISITES

This script requires the C&lt;Getopt::Long&gt;, C&lt;Pod::Usage&gt; and C&lt;Carp&gt; packages, which
should be on your system anyway.  Additionally, C&lt;Term::ReadLine&gt; and C&lt;Term::ANSIColor&gt;
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&lt;Net::POP3&gt;,
which is required.

=head1 SYNOPSIS

  pop3list [OPTIONS]

  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
        --port       override the TCP port (default: 110)
        --timeout    response timeout in secs (default: 120)
        --help       this help screen
        --version    version  information

=head1 DESCRIPTION

pop3list is part of the POP3Utils package, and is used to
programatically list the contents of a POP3 account.  It
accepts a bunch of nifty input that allows you to change it's
behavior.  It's really quite a cool idea, IMHO.

=head1 README

pop3list is part of the POP3Utils package, and is used to
programatically list the contents of a POP3 account.  It
accepts a bunch of nifty input that allows you to change it's
behavior.  It's really quite a cool idea, IMHO.

=head1 AUTHOR

Michael A Nachbaur, E&lt;lt&gt;mike@nachbaur.comE&lt;gt&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&lt;pop3dele&gt;, L&lt;pop3retr&gt;.

=head1 REVISION

$Id: pop3list,v 1.3 2003/09/10 17:44:54 nachbaur Exp $

=cut
</pre></body></html>