First pass at adding key files
This commit is contained in:
dsainty
829
site/slowtwitch.com/cgi-bin/articles/GT/Mail/POP3.pm
Normal file
829
site/slowtwitch.com/cgi-bin/articles/GT/Mail/POP3.pm
Normal file
@ -0,0 +1,829 @@
|
||||
# ==================================================================
|
||||
# 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 $
|
||||
|
||||
Reference in New Issue
Block a user