830 lines
24 KiB
Perl
830 lines
24 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Mail::POP3
|
|
# Author: Scott Beck
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: POP3.pm,v 1.57 2008/09/23 23:55:26 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: A general purpose perl interface to a POP3 server.
|
|
#
|
|
|
|
package GT::Mail::POP3;
|
|
# ==================================================================
|
|
|
|
# Pragmas
|
|
use strict;
|
|
use vars qw!$VERSION $DEBUG $ERROR $CRLF @ISA $ERRORS $ATTRIBS!;
|
|
|
|
# Constants
|
|
use constants TIMEOUT => 0.01; # The timeout used on selects.
|
|
|
|
# Internal modules
|
|
use GT::Base;
|
|
use GT::Socket::Client;
|
|
use GT::Mail::Parts;
|
|
use GT::Mail::Parse;
|
|
|
|
# System modules
|
|
use Fcntl qw/O_NONBLOCK F_SETFL F_GETFL/;
|
|
use POSIX qw/EAGAIN EINTR/;
|
|
|
|
# Silence warnings
|
|
$GT::Mail::Parse::error = '';
|
|
|
|
@ISA = qw(GT::Base);
|
|
$DEBUG = 0;
|
|
$CRLF = "\r\n";
|
|
$| = 1;
|
|
|
|
$ATTRIBS = {
|
|
host => undef,
|
|
port => undef,
|
|
user => undef,
|
|
pass => undef,
|
|
auth_mode => 'PASS',
|
|
debug => 0,
|
|
blocking => 0,
|
|
ssl => 0,
|
|
timeout => 30, # The connection timeout (passed to GT::Socket::Client)
|
|
data_timeout => 5, # The timeout to read/write data from/to the connected socket
|
|
};
|
|
|
|
$ERRORS = {
|
|
NOTCONNECTED => "You are calling %s and you have not connected yet!",
|
|
CANTCONNECT => "Could not connect to POP3 server: %s",
|
|
READ => "Unble to read from socket, reason (%s). Read: (%s)",
|
|
WRITE => "Unable to write %s length to socket. Wrote %s, Error(%s)",
|
|
NOEOF => "No EOF or EOL found. Socket locked.",
|
|
ACTION => "Could not %s. Server said: %s",
|
|
NOMD5 => "Unable to load GT::MD5 (required for APOP authentication): %s",
|
|
PARSE => "An error occurred while parsing an email: %s",
|
|
LOGIN => "An error occurred while logging in: %s",
|
|
OPEN => "Could not open (%s) for read and write. Reason: %s",
|
|
};
|
|
|
|
sub head_part {
|
|
# --------------------------------------------------------
|
|
# my $head = $obj->head_part($num);
|
|
# ---------------------------------
|
|
# This method takes one argument, the number message to
|
|
# parse. It returns a GT::Mail::Parts object that has
|
|
# only the top level head part parsed.
|
|
#
|
|
my ($self, $num) = @_;
|
|
$num and $num =~ /^\d+$/ or return $self->error("BADARGS", "FATAL", '$obj->head_part ($msg_num)');
|
|
my $io = '';
|
|
$self->top($num, sub { $io .= $_[0] }) or return;
|
|
return GT::Mail::Parse->new(debug => $self->{_debug}, crlf => $CRLF)->parse_head(\$io);
|
|
}
|
|
|
|
sub all_head_parts {
|
|
# --------------------------------------------------------
|
|
# my @heads = $obj->all_head_parts;
|
|
# ---------------------------------
|
|
# This does much the same as head_part() but returns an
|
|
# array of GT::Mail::Parts objects, each one only having
|
|
# the head of the message parsed.
|
|
#
|
|
my $self = shift;
|
|
my @head_parts;
|
|
for (1 .. $self->stat) {
|
|
my $part = $self->head_part($_) or return;
|
|
push(@head_parts, $part);
|
|
}
|
|
return wantarray ? @head_parts : \@head_parts;
|
|
}
|
|
|
|
sub parse_message {
|
|
# --------------------------------------------------------
|
|
# my $mail = $obj->parse_message($num);
|
|
# -------------------------------------
|
|
# This method returns a GT::Mail object. It calles parse
|
|
# for the message number specified before returning the
|
|
# object. You can retrieve the different parts of the
|
|
# message through the GT::Mail object. If this method
|
|
# fails you should check $GT::Mail::error.
|
|
#
|
|
my ($self, $num) = @_;
|
|
$num and $num =~ /^\d+$/ or return $self->error("BADARGS", "FATAL", '$obj->parse_message($msg_num)');
|
|
my $io = $self->retr($num) or return;
|
|
my $parser = new GT::Mail::Parse(debug => $self->{_debug}, in_string => $io, crlf => $CRLF);
|
|
$parser->parse or return $self->error("PARSE", "WARN", $GT::Mail::Parse::error);
|
|
return $parser;
|
|
}
|
|
|
|
sub init {
|
|
# --------------------------------------------------------
|
|
# Initilize the POP box object.
|
|
#
|
|
my $self = shift;
|
|
|
|
$self->set(@_);
|
|
|
|
for (qw/user pass host/) {
|
|
(defined($self->{$_})) or return $self->error('BADARGS', 'FATAL', "CLASS->new(%ARGS); The '$_' key in the hash must exists");
|
|
}
|
|
$self->{_debug} = exists($self->{debug}) ? delete($self->{debug}) : $DEBUG;
|
|
|
|
# Can be either PASS or APOP depending on login type.
|
|
$self->{auth_mode} ||= 'PASS';
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub send {
|
|
# --------------------------------------------------------
|
|
# Send a message to the server.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
|
|
unless (defined $msg and length $msg) {
|
|
$self->debug("Sending blank message!") if $self->{_debug};
|
|
return;
|
|
}
|
|
|
|
# Get the socket and end of line.
|
|
my $s = $self->{sock};
|
|
defined($s) and defined fileno($s) or return $self->error("NOTCONNECTED", "WARN", "send()");
|
|
|
|
# Print the message.
|
|
$self->debug("--> $msg") if $self->{_debug};
|
|
|
|
$s->write($msg . $CRLF);
|
|
|
|
$self->getline(my $line) or return;
|
|
|
|
$line =~ s/$CRLF//o if $line;
|
|
$line ||= 'Nothing sent back';
|
|
$self->{message} = $line;
|
|
$self->debug("<-- $line") if $self->{_debug};
|
|
|
|
return $line;
|
|
}
|
|
|
|
sub getline {
|
|
# --------------------------------------------------------
|
|
# Read a line of input from the server.
|
|
#
|
|
my ($self) = @_;
|
|
my $got_cr;
|
|
my $safety;
|
|
my $s = $self->{sock};
|
|
$s->readline($_[1]);
|
|
return 1;
|
|
}
|
|
|
|
sub getall {
|
|
# --------------------------------------------------------
|
|
# Get all pending output from the server.
|
|
#
|
|
my ($self) = @_;
|
|
$_[1] = '';
|
|
my $l = 0;
|
|
my $safety;
|
|
my $s = $self->{sock};
|
|
if ($self->{blocking}) {
|
|
while (<$s>) {
|
|
last if /^\.$CRLF/o;
|
|
s/^\.//; # Lines starting with a . are doubled up in POP3
|
|
$_[1] .= $_;
|
|
}
|
|
}
|
|
else {
|
|
my $save = $s->read_size;
|
|
$s->read_size(1048576);
|
|
$s->readalluntil("\n.$CRLF", $_[1], ".$CRLF");
|
|
$s->read_size($save);
|
|
|
|
$_[1] =~ s/\n\.\r?\n$/\n/; # Remove the final . at the end of the e-mail
|
|
$_[1] =~ s/^\.//mg; # Remove the initial '.' from any lines beginning with .
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub connect {
|
|
# --------------------------------------------------------
|
|
# Connect to the server.
|
|
#
|
|
my $self = shift;
|
|
my ($s, $iaddr, $msg, $paddr, $proto);
|
|
|
|
$self->debug("Attempting to connect .. ") if ($self->{_debug});
|
|
|
|
$self->{blocking} = 1 if $self->{ssl};
|
|
$self->{port} ||= $self->{ssl} ? 995 : 110;
|
|
|
|
# If there was an existing connection, it'll be closed here when we reassign
|
|
$self->{sock} = GT::Socket::Client->open(
|
|
port => $self->{port},
|
|
host => $self->{host},
|
|
max_down => 0,
|
|
timeout => $self->{timeout},
|
|
non_blocking => !$self->{blocking},
|
|
select_time => TIMEOUT,
|
|
read_wait => $self->{data_timeout},
|
|
ssl => $self->{ssl},
|
|
debug => $self->{_debug}
|
|
) or return $self->error("CANTCONNECT", "WARN", GT::Socket::Client->error);
|
|
|
|
$self->debug('Connected to ' . $self->{host} . ' on port ' . $self->{port} . ($self->{ssl} ? ' via SSL' : '')) if $self->{_debug};
|
|
|
|
# Get server welcoming.
|
|
$self->getline($msg) or return;
|
|
|
|
# Store this - it's needed for APOP authentication
|
|
$self->{msg_id}= $1 if ($msg =~ /(<[\w\d\-\.]+\@[\w\d\-\.]+>)/);
|
|
|
|
$self->debug("Going to login") if $self->{_debug};
|
|
return $self->login();
|
|
}
|
|
|
|
sub login {
|
|
# --------------------------------------------------------
|
|
# Login either using APOP or regular.
|
|
#
|
|
my $self = shift;
|
|
($self->{auth_mode} eq 'APOP' && $self->{msg_id}) ? $self->login_apop : $self->login_pass;
|
|
}
|
|
|
|
sub login_apop {
|
|
# --------------------------------------------------------
|
|
# Login using APOP.
|
|
#
|
|
my $self = shift;
|
|
my ($hash, $count, $line);
|
|
{
|
|
local $SIG{__DIE__};
|
|
eval { require GT::MD5; 1 } or return $self->error('NOMD5', 'WARN', $@);
|
|
}
|
|
$self->debug("Attempting to log in via APOP ... ") if $self->{_debug};
|
|
$hash = GT::MD5::md5_hex($self->{msg_id} . $self->{pass});
|
|
|
|
local ($_) = $self->send('APOP ' . $self->{user} . ' ' . $hash) or return;
|
|
substr($_, 0, 1) eq '+' or return $self->error("LOGIN", "WARN", "APOP Login failed: $_");
|
|
if (/^\+OK \S+ has (\d+) /i) {
|
|
$self->{count} = $1;
|
|
}
|
|
elsif (uc substr($_, 0, 3) ne '+OK') {
|
|
return $self->error('LOGIN', 'WARN', $_);
|
|
}
|
|
$self->{state} = 'TRANSACTION';
|
|
$self->stat() or return;
|
|
|
|
$self->debug("APOP Login successful.") if $self->{_debug};
|
|
return (($self->{count} == 0) ? '0E0' : $self->{count});
|
|
}
|
|
|
|
sub login_pass {
|
|
# --------------------------------------------------------
|
|
# Login using clear text authentication.
|
|
#
|
|
my $self = shift;
|
|
my ($line);
|
|
|
|
$self->debug("Attempting to log in via clear text ... ") if $self->{_debug};
|
|
|
|
# Enter username.
|
|
local($_) = $self->send('USER ' . $self->{user}) or return;
|
|
substr($_, 0, 1) eq '+' or return $self->error('LOGIN', 'WARN', "USER POP Login failed: $_");
|
|
|
|
# Enter password.
|
|
$_ = $self->send('PASS ' . $self->{pass}) or return;
|
|
substr($_, 0, 1) eq '+' or return $self->error('LOGIN', 'WARN', "PASS POP Login failed: $_");
|
|
|
|
# Ok, get total number of message, and pop box status.
|
|
if (/^\+OK \S+ has (\d+) /i) {
|
|
$self->{count} = $1;
|
|
}
|
|
elsif (uc substr($_, 0, 3) ne '+OK') {
|
|
return $self->error('LOGIN', 'WARN', $_);
|
|
}
|
|
$self->stat() or return;
|
|
|
|
$self->debug("Login successful.") if $self->{_debug};
|
|
return $self->{count} == 0 ? '0E0' : $self->{count};
|
|
}
|
|
|
|
sub top {
|
|
# --------------------------------------------------------
|
|
# Get the header of a message and the next x lines (optional).
|
|
#
|
|
my ($self, $num, $code) = @_;
|
|
defined($num) or return $self->error('BADARGS', 'FATAL', '$obj->head($msg_num);. No message number passed to head.');
|
|
$self->debug("Getting head of message $num ... ") if $self->{_debug};
|
|
|
|
local($_) = $self->send("TOP $num 0") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "TOP $num 0", "($_)");
|
|
|
|
my ($tp, $header);
|
|
$self->getall($header);
|
|
if (substr($header, 0, 1) eq '>') {
|
|
substr($header, 0, index($header, $CRLF) + 2) = '';
|
|
}
|
|
|
|
# Support broken headers which given unix linefeeds.
|
|
if ($header =~ /[^\r]\n/) {
|
|
$header =~ s/\r?\n/$CRLF/g;
|
|
}
|
|
$self->debug("Top of message $num retrieved.") if $self->{_debug};
|
|
if ($code and ref $code eq 'CODE') {
|
|
$code->($header);
|
|
}
|
|
else {
|
|
return wantarray ? split(/$CRLF/o, $header) : $header;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub retr {
|
|
# --------------------------------------------------------
|
|
# Get the entire message.
|
|
#
|
|
my ($self, $num, $code) = @_;
|
|
defined($num) or return $self->error('BADARGS', 'FATAL', '$obj->retr ($msg_numm, $code);');
|
|
|
|
$self->debug("Getting message $num ... ") if ($self->{_debug});
|
|
|
|
# Get the size of the message
|
|
local ($_) = $self->send("RETR $num") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error('ACTION', 'WARN', "RETR $num", $_);
|
|
|
|
# Retrieve the entire email
|
|
my $body = '';
|
|
$self->getall($body);
|
|
|
|
# Qmail puts this wierd header as the first line
|
|
if (substr($body, 0, 1) eq '>') {
|
|
substr($body, 0, index($body, $CRLF) + 2) = '';
|
|
}
|
|
|
|
# Support broken pop servers that send us unix linefeeds.
|
|
if ($body =~ /[^\r]\n/) {
|
|
$body =~ s/\r?\n/$CRLF/g;
|
|
}
|
|
$self->debug("Message $num retrieved.") if $self->{_debug};
|
|
if ($code and ref $code eq 'CODE') {
|
|
$code->($body);
|
|
}
|
|
else {
|
|
return \$body;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub last {
|
|
my ($self) = @_;
|
|
|
|
local($_) = $self->send("LAST") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "LAST", $_);
|
|
s/^\+OK\s*//i;
|
|
return $_;
|
|
}
|
|
|
|
sub message_save {
|
|
# --------------------------------------------------------
|
|
# Get a message and save it to a file rather then returning.
|
|
#
|
|
my ($self, $num, $file) = @_;
|
|
|
|
# Check arguments.
|
|
$num or return $self->error("BADARGS", "FATAL", '$obj->message_save ($msg_num, $IO);');
|
|
$file or return $self->error("BADARGS", "FATAL", '$obj->message_save ($msg_num, $IO);');
|
|
|
|
my $io;
|
|
if (ref $file) {
|
|
$io = $file;
|
|
}
|
|
else {
|
|
$file =~ /^\s*(.+?)\s*$/ and $file = $1;
|
|
$io = \do { local *FH; *FH };
|
|
open $io, ">$file" or return $self->error("OPENWRITE", "FATAL", $file, "$!");
|
|
}
|
|
|
|
# Get the entire message body.
|
|
$self->retr($num, sub { print $io $_[0] });
|
|
$self->debug("Message $num saved to '$file'.") if $self->{_debug};
|
|
return 1;
|
|
}
|
|
|
|
sub stat {
|
|
# --------------------------------------------------------
|
|
# Handle a stat command, get the number of messages and size.
|
|
#
|
|
my $self = shift;
|
|
|
|
local($_) = $self->send("STAT") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error('ACTION', 'WARN', 'STAT', $_);
|
|
if (/^\+OK (\d+) (\d+)/i) {
|
|
$self->{count} = $1;
|
|
$self->{size} = $2;
|
|
$self->debug("STAT successful - count: $1 size: $2") if $self->{_debug};
|
|
}
|
|
else {
|
|
$self->debug("STAT failed, can't determine count.") if $self->{_debug};
|
|
}
|
|
return $self->{count} || "0E0";
|
|
}
|
|
|
|
sub list {
|
|
# --------------------------------------------------------
|
|
# Return a list of messages available.
|
|
#
|
|
my $self = shift;
|
|
my $num = shift || '';
|
|
my @messages;
|
|
|
|
# Broken pop servers that don't like 'LIST '.
|
|
my $cmd = ($num eq '') ? 'LIST' : "LIST $num";
|
|
|
|
local($_) = $self->send($cmd) or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "LIST $num", $_);
|
|
if ($num) {
|
|
s/^\+OK\s*//i;
|
|
return $_;
|
|
}
|
|
my $msg = '';
|
|
$self->getall($msg);
|
|
@messages = split /$CRLF/o => $msg;
|
|
$self->debug(@messages . " messages listed.") if ($self->{_debug});
|
|
if (@messages) {
|
|
return wantarray ? @messages : join("", @messages);
|
|
}
|
|
}
|
|
|
|
sub rset {
|
|
# --------------------------------------------------------
|
|
# Reset deletion stat.
|
|
#
|
|
my $self = shift;
|
|
local($_) = $self->send("RSET") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "RSET", $_);
|
|
return 1;
|
|
}
|
|
|
|
sub dele {
|
|
# --------------------------------------------------------
|
|
# Delete a given message.
|
|
#
|
|
my ($self, $num) = @_;
|
|
$num and $num =~ /^\d+$/ or return $self->error("BADARGS", "FATAL", '$obj->dele ($msg_num)');
|
|
local($_) = $self->send("DELE $num") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "DELE $num", $_);
|
|
return 1;
|
|
}
|
|
|
|
sub quit {
|
|
# --------------------------------------------------------
|
|
# Close the socket.
|
|
#
|
|
my $self = shift;
|
|
$self->send("QUIT") or return;
|
|
close $self->{sock};
|
|
$self->{sock} = undef;
|
|
return 1;
|
|
}
|
|
|
|
sub uidl {
|
|
# --------------------------------------------------------
|
|
# Returns a list of uidls from the remote server
|
|
#
|
|
my $self = shift;
|
|
my $num = shift;
|
|
local $_;
|
|
if ($num and !ref $num) {
|
|
$_ = $self->send("UIDL $num") or return;
|
|
/^\+OK \d+ (.+)$/i or return $self->error("ACTION", "WARN", "UIDL $num", $_);
|
|
return $1;
|
|
}
|
|
my $ret = {};
|
|
$_ = $self->send("UIDL") or return;
|
|
uc substr($_, 0, 3) eq '+OK' or return $self->error("ACTION", "WARN", "UIDL $num", $_);
|
|
my $list = '';
|
|
$self->getall($list);
|
|
for (split /$CRLF/o => $list) {
|
|
if ($num and ref($num) eq 'CODE') {
|
|
$num->($_);
|
|
}
|
|
else {
|
|
/^(\d+) (.+)/ and $ret->{$1} = $2;
|
|
}
|
|
}
|
|
return wantarray ? %{$ret} : $ret;
|
|
}
|
|
|
|
sub count {
|
|
# --------------------------------------------------------
|
|
# Accessor for number of messages waiting.
|
|
#
|
|
return $_[0]->{count};
|
|
}
|
|
|
|
sub size {
|
|
# --------------------------------------------------------
|
|
# Accessor for size of messages waiting.
|
|
#
|
|
return $_[0]->{count};
|
|
}
|
|
|
|
sub last_message {
|
|
# --------------------------------------------------------
|
|
# Accessor for last server message.
|
|
|
|
@_ == 2 and $_[0]->{message} = $_[1];
|
|
return $_[0]->{message};
|
|
}
|
|
|
|
sub DESTROY {
|
|
# --------------------------------------------------------
|
|
# Auto close the socket.
|
|
#
|
|
my $self = shift;
|
|
if ($self->{sock} and defined fileno($self->{sock})) {
|
|
$self->send("QUIT");
|
|
close $self->{sock};
|
|
$self->{sock} = undef;
|
|
}
|
|
$self->debug("POP Object destroyed.") if ($self->{_debug} > 1);
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Mail::POP3 - Receieve email through POP3 protocal
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::Mail::POP3;
|
|
|
|
my $pop = GT::Mail::POP3->new(
|
|
host => 'mail.gossamer-threads.com',
|
|
port => 110,
|
|
user => 'someusername',
|
|
pass => 'somepassword',
|
|
auth_mode => 'PASS',
|
|
timeout => 30,
|
|
debug => 1
|
|
);
|
|
|
|
my $count = $pop->connect or die $GT::Mail::POP3::error;
|
|
|
|
for my $num (1 .. $count) {
|
|
my $top = $pop->parse_head($num);
|
|
|
|
my @to = $top->split_field;
|
|
|
|
if (grep /myfriend\@gossamer-threads\.com/, @to) {
|
|
$pop->message_save($num, '/keep/email.txt');
|
|
last;
|
|
}
|
|
}
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::Mail::POP3 is a module to check an email account using the POP3 protocol.
|
|
Many of the methods are integrated with L<GT::Mail::Parse>.
|
|
|
|
=head2 new - constructor method
|
|
|
|
This method is inherited from L<GT::Base>. The argument to this method can be
|
|
in the form of a hash or hash ref. As a minimum 'user', 'pass', and 'host' must
|
|
be specified.
|
|
|
|
=over 4
|
|
|
|
=item debug
|
|
|
|
Sets the debugging level for this instance of GT::Mail::POP3.
|
|
|
|
=item host
|
|
|
|
Sets the host to connect to for checking a POP account. This argument must be
|
|
provided.
|
|
|
|
=item port
|
|
|
|
Sets the port on the POP server to attempt to connect to. This defaults to 110,
|
|
unless using SSL, for which the default is 995.
|
|
|
|
=item ssl
|
|
|
|
Establishes the connection using SSL. Note that this requires Net::SSLeay of
|
|
at least version 1.06.
|
|
|
|
=item user
|
|
|
|
Sets the user name to login with when connecting to the POP server. This must
|
|
be specified.
|
|
|
|
=item pass
|
|
|
|
Sets the password to login with when connection to the POP server. This must be
|
|
specified.
|
|
|
|
=item auth_mode
|
|
|
|
Sets the authentication type for this connection. This can be one of two
|
|
values. PASS (the default) or APOP. If set to APOP, GT::Mail::POP3 will use
|
|
APOP to login to the remote server.
|
|
|
|
=item timeout
|
|
|
|
Sets the connection timeout. This isn't entirely reliable as it uses alarm(),
|
|
which isn't supported on all systems. That aside, this normally isn't needed
|
|
if you want a timeout - it defaults to 30 on alarm()-supporting systems. The
|
|
main purpose is to provide a value of 0 to disable the alarm() timeout.
|
|
|
|
=back
|
|
|
|
=head2 connect - Connect to the POP account
|
|
|
|
$obj->connect or die $GT::Mail::POP3::error;
|
|
|
|
This method performs the connection to the POP server. Returns the count of
|
|
messages on the server on success, and undefined on failure. Takes no arguments
|
|
and called before you can perform any actions on the POP server.
|
|
|
|
=head2 head_part - Access the email header
|
|
|
|
# Get a parsed header part object for the first email in the list.
|
|
my $top_part = $obj->head_part(1);
|
|
|
|
Instance method. The only argument to this method is the message number to get.
|
|
Returns a L<GT::Mail::Parts> object containing only the parsed header of the
|
|
specified message.
|
|
|
|
=head2 all_head_parts - Access all email headers
|
|
|
|
# Get all the head parts from all messages
|
|
my @headers = $obj->all_head_parts;
|
|
|
|
Instance method. Gets all the headers of all the email's on the remote server.
|
|
Returns an array of the L<GT::Mail::Parts> object. One object for each
|
|
email. None of the email's bodies are retrieved, only the head.
|
|
|
|
=head2 parse_message - Access an email
|
|
|
|
# Parse an email and get the GT::Mail object
|
|
my $mail = $obj->parse_message (1);
|
|
|
|
Instance method. Pass in the number of the email to retrieve. This method
|
|
retrieves the specified email and returns the parsed GT::Mail object. If this
|
|
method fails you should check $GT::Mail::error for the error message.
|
|
|
|
=head2 message_save - Save an email
|
|
|
|
open FH, '/path/to/email.txt' or die $!;
|
|
|
|
# Save message 2 to file
|
|
$obj->message_save (2, \*FH);
|
|
close FH;
|
|
|
|
- or -
|
|
|
|
$obj->message_save (2, '/path/to/email.txt') or die $GT::Mail::POP3::error;
|
|
|
|
Instance method. This method takes the message number as it's first argument,
|
|
and either a file path or a file handle ref as it's second argument. If a file
|
|
path is provided the file will be opened to truncate. The email is then
|
|
retrieved from the server and written to the file.
|
|
|
|
=head2 stat - Do a STAT command
|
|
|
|
# Get the number of messages on the server
|
|
my $count = $obj->stat;
|
|
|
|
Instance method. Does a STAT command on the remote server. It stores the total
|
|
size and returns the count of messages on the server, if successful. Otherwise
|
|
returns undef.
|
|
|
|
=head2 list - Do a LIST command
|
|
|
|
# At a list of messages on the server
|
|
my @messages = $obj->list;
|
|
|
|
Instance method. Does a LIST command on the remote server. Returns an array of
|
|
the lines in list context and a single scalar that contains all the lines in
|
|
scalar context.
|
|
|
|
=head2 rset - Do an RSET command
|
|
|
|
# Tell the server to ignore any dele commands we have issued in this
|
|
# session
|
|
$obj->rset;
|
|
|
|
Instance method. Does an RSET command. This command resets the servers
|
|
knowledge of what should be deleted when QUIT is called. Returns 1 on success.
|
|
|
|
=head2 dele - Do a DELE command
|
|
|
|
# Delete message 4
|
|
$obj->dele (4);
|
|
|
|
Instance method. Does a DELE command. The only argument is the message number
|
|
to delete. Returns 1 on success.
|
|
|
|
=head2 quit - Quit the connection
|
|
|
|
# Close our connection
|
|
$obj->quit;
|
|
|
|
Instance method. Sends the QUIT command to the server. The should should
|
|
disconnect soon after this. No more actions can be taken on this connection
|
|
until connect is called again.
|
|
|
|
=head2 uidl - Do a UIDL command
|
|
|
|
# Get the uidl for message 1
|
|
my $uidl = $obj->uidl (1);
|
|
|
|
# Get a list of all the uidl's and print them
|
|
$obj->uidl (sub { print @_ });
|
|
|
|
# Get an array of all the uidl's
|
|
my @uidl = $obj->uidl;
|
|
|
|
Instance method. Attempts to do a UIDL command on the remote server. Please be
|
|
aware support for the UIDL command is not very wide spread. This method can
|
|
take the message number as it's first argument. If the message number is given,
|
|
the UIDL for that message is returned. If the first argument is a code
|
|
reference, a UIDL command is done with no message specified and the code
|
|
reference is called for each line returned from the remote server. If no second
|
|
argument is given, a UIDL command is done, and the results are returned in a
|
|
has of message number to UIDL.
|
|
|
|
=head2 count - Get the number of messages
|
|
|
|
# Get the count from the last STAT
|
|
my $count = $obj->count;
|
|
|
|
This method returns the number of messages on the server from the last STAT
|
|
command. A STAT is done on connect.
|
|
|
|
=head2 size - Get the size of all messages
|
|
|
|
# Get the total size of all messages on the server
|
|
my $size = $obj->size;
|
|
|
|
This method returns the size of all messages in the server as returned by the
|
|
last STAT command sent to the server.
|
|
|
|
=head2 send - Send a raw command
|
|
|
|
# Send a raw command to the server
|
|
my $ret = $obj->send ("HELO");
|
|
|
|
This method sends the specified raw command to the POP server. The one line
|
|
return from the server is returned. Do not call this method if you are
|
|
expecting more than a one line response.
|
|
|
|
=head2 top - Retrieve the header
|
|
|
|
# Get the header of message 2 in an array. New lines are stripped
|
|
my @header = $obj->top (2);
|
|
|
|
# Get the header as a string
|
|
my $header = $obj->top (2);
|
|
|
|
Instance method to retrieve the top of an email on the POP server. The only
|
|
argument should be the message number to retrieve. Returns a scalar containing
|
|
the header in scalar context and an array, which is the scalar split on
|
|
\015?\012, in list context.
|
|
|
|
=head2 retr - Retrieve an email
|
|
|
|
# Get message 3 from the remote server in an array. New lines are stripped
|
|
my @email = $obj->retr (3);
|
|
|
|
# Get it as a string
|
|
my $email = $obj->retr (3);
|
|
|
|
Instance method to retrieve an email from the POP server. The first argument to
|
|
this method should be the message number to retrieve. The second argument is an
|
|
optional code ref to call for each line of the message that is retrieved. If no
|
|
code ref is specified, this method will put the email in a scalar and return
|
|
the scalar in scalar context and return the scalar split on \015?\012 in list
|
|
context.
|
|
|
|
=head1 REQUIREMENTS
|
|
|
|
L<GT::Socket::Client>
|
|
L<GT::Base>
|
|
L<GT::MD5> (for APOP authentication)
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: POP3.pm,v 1.57 2008/09/23 23:55:26 brewt Exp $
|
|
|