[perl5.git] / lib / Net / POP3.pm

# Net::POP3.pm
#
# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Net::POP3;

use strict;
use IO::Socket;
use vars qw(@ISA $VERSION $debug);
use Net::Cmd;
use Carp;
use Net::Config;

$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $

@ISA = qw(Net::Cmd IO::Socket::INET);

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;
 my $host = shift if @_ % 2;
 my %arg  = @_; 
 my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts};
 my $obj;
 my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): ();

 my $h;
 foreach $h (@{$hosts})
  {
   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
			    PeerPort => $arg{Port} || 'pop3(110)',
			    Proto    => 'tcp',
			    @localport,
			    Timeout  => defined $arg{Timeout}
						? $arg{Timeout}
						: 120
			   ) and last;
  }

 return undef
	unless defined $obj;

 ${*$obj}{'net_pop3_host'} = $host;

 $obj->autoflush(1);
 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);

 unless ($obj->response() == CMD_OK)
  {
   $obj->close();
   return undef;
  }

 ${*$obj}{'net_pop3_banner'} = $obj->message;

 $obj;
}

##
## We don't want people sending me their passwords when they report problems
## now do we :-)
##

sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }

sub login
{
 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
 my($me,$user,$pass) = @_;

 if (@_ <= 2) {
   ($user, $pass) = $me->_lookup_credentials($user);
 }

 $me->user($user) and
    $me->pass($pass);
}

sub apop
{
 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
 my($me,$user,$pass) = @_;
 my $banner;
 my $md;

 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
   $md = Digest::MD5->new();
 } elsif (eval { local $SIG{__DIE__}; require MD5 }) {
   $md = MD5->new();
 } else {
   carp "You need to install Digest::MD5 or MD5 to use the APOP command";
   return undef;
 }

 return undef
   unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );

 if (@_ <= 2) {
   ($user, $pass) = $me->_lookup_credentials($user);
 }

 $md->add($banner,$pass);

 return undef
    unless($me->_APOP($user,$md->hexdigest));

 $me->_get_mailbox_count();
}

sub user
{
 @_ == 2 or croak 'usage: $pop3->user( USER )';
 $_[0]->_USER($_[1]) ? 1 : undef;
}

sub pass
{
 @_ == 2 or croak 'usage: $pop3->pass( PASS )';

 my($me,$pass) = @_;

 return undef
   unless($me->_PASS($pass));

 $me->_get_mailbox_count();
}

sub reset
{
 @_ == 1 or croak 'usage: $obj->reset()';

 my $me = shift;

 return 0 
   unless($me->_RSET);

 if(defined ${*$me}{'net_pop3_mail'})
  {
   local $_;
   foreach (@{${*$me}{'net_pop3_mail'}})
    {
     delete $_->{'net_pop3_deleted'};
    }
  }
}

sub last
{
 @_ == 1 or croak 'usage: $obj->last()';

 return undef
    unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;

 return $1;
}

sub top
{
 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
 my $me = shift;

 return undef
    unless $me->_TOP($_[0], $_[1] || 0);

 $me->read_until_dot;
}

sub popstat
{
 @_ == 1 or croak 'usage: $pop3->popstat()';
 my $me = shift;

 return ()
    unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;

 ($1 || 0, $2 || 0);
}

sub list
{
 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
 my $me = shift;

 return undef
    unless $me->_LIST(@_);

 if(@_)
  {
   $me->message =~ /\d+\D+(\d+)/;
   return $1 || undef;
  }

 my $info = $me->read_until_dot
	or return undef;

 my %hash = map { (/(\d+)\D+(\d+)/) } @$info;

 return \%hash;
}

sub get
{
 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
 my $me = shift;

 return undef
    unless $me->_RETR(shift);

 $me->read_until_dot(@_);
}

sub getfh
{
 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
 my $me = shift;

 return unless $me->_RETR(shift);
 return        $me->tied_fh;
}


sub delete
{
 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
 $_[0]->_DELE($_[1]);
}

sub uidl
{
 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
 my $me = shift;
 my $uidl;

 $me->_UIDL(@_) or
    return undef;
 if(@_)
  {
   $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
  }
 else
  {
   my $ref = $me->read_until_dot
	or return undef;
   my $ln;
   $uidl = {};
   foreach $ln (@$ref) {
     my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
     $uidl->{$msg} = $uid;
   }
  }
 return $uidl;
}

sub ping
{
 @_ == 2 or croak 'usage: $pop3->ping( USER )';
 my $me = shift;

 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;

 ($1 || 0, $2 || 0);
}

sub _lookup_credentials
{
  my ($me, $user) = @_;

  require Net::Netrc;

  $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
    $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};

  my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
  $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});

  my $pass = $m ? $m->password || ""
                : "";

  ($user, $pass);
}

sub _get_mailbox_count
{
  my ($me) = @_;
  my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
	  ? $1 : ($me->popstat)[0];

  $ret ? $ret : "0E0";
}


sub _STAT { shift->command('STAT')->response() == CMD_OK }
sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
sub _RSET { shift->command('RSET')->response() == CMD_OK }
sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }

sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
sub _LAST { shift->command('LAST')->response() == CMD_OK }

sub quit
{
 my $me = shift;

 $me->_QUIT;
 $me->close;
}

sub DESTROY
{
 my $me = shift;

 if(defined fileno($me))
  {
   $me->reset;
   $me->quit;
  }
}

##
## POP3 has weird responses, so we emulate them to look the same :-)
##

sub response
{
 my $cmd = shift;
 my $str = $cmd->getline() || return undef;
 my $code = "500";

 $cmd->debug_print(0,$str)
   if ($cmd->debug);

 if($str =~ s/^\+OK\s+//io)
  {
   $code = "200"
  }
 else
  {
   $str =~ s/^-ERR\s+//io;
  }

 ${*$cmd}{'net_cmd_resp'} = [ $str ];
 ${*$cmd}{'net_cmd_code'} = $code;

 substr($code,0,1);
}

1;

__END__

=head1 NAME

Net::POP3 - Post Office Protocol 3 Client class (RFC1939)

=head1 SYNOPSIS

    use Net::POP3;

    # Constructors
    $pop = Net::POP3->new('pop3host');
    $pop = Net::POP3->new('pop3host', Timeout => 60);

=head1 DESCRIPTION

This module implements a client interface to the POP3 protocol, enabling
a perl5 application to talk to POP3 servers. This documentation assumes
that you are familiar with the POP3 protocol described in RFC1939.

A new Net::POP3 object must be created with the I<new> method. Once
this has been done, all POP3 commands are accessed via method calls
on the object.

=head1 EXAMPLES

    Need some small examples in here :-)

=head1 CONSTRUCTOR

=over 4

=item new ( [ HOST, ] [ OPTIONS ] )

This is the constructor for a new Net::POP3 object. C<HOST> is the
name of the remote host to which a POP3 connection is required.

If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
will be used.

C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
Possible options are:

B<ResvPort> - If given then the socket for the C<Net::POP3> object
will be bound to the local port given using C<bind> when the socket is
created.

B<Timeout> - Maximum time, in seconds, to wait for a response from the
POP3 server (default: 120)

B<Debug> - Enable debugging information

=back

=head1 METHODS

Unless otherwise stated all methods return either a I<true> or I<false>
value, with I<true> meaning that the operation was a success. When a method
states that it returns a value, failure will be returned as I<undef> or an
empty list.

=over 4

=item user ( USER )

Send the USER command.

=item pass ( PASS )

Send the PASS command. Returns the number of messages in the mailbox.

=item login ( [ USER [, PASS ]] )

Send both the USER and PASS commands. If C<PASS> is not given the
C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
and username. If the username is not specified then the current user name
will be used.

Returns the number of messages in the mailbox. However if there are no
messages on the server the string C<"0E0"> will be returned. This is
will give a true value in a boolean context, but zero in a numeric context.

If there was an error authenticating the user then I<undef> will be returned.

=item apop ( [ USER [, PASS ]] )

Authenticate with the server identifying as C<USER> with password C<PASS>.
Similar to L</login>, but the password is not sent in clear text.

To use this method you must have the Digest::MD5 or the MD5 module installed,
otherwise this method will return I<undef>.

=item top ( MSGNUM [, NUMLINES ] )

Get the header and the first C<NUMLINES> of the body for the message
C<MSGNUM>. Returns a reference to an array which contains the lines of text
read from the server.

=item list ( [ MSGNUM ] )

If called with an argument the C<list> returns the size of the message
in octets.

If called without arguments a reference to a hash is returned. The
keys will be the C<MSGNUM>'s of all undeleted messages and the values will
be their size in octets.

=item get ( MSGNUM [, FH ] )

Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
then get returns a reference to an array which contains the lines of
text read from the server. If C<FH> is given then the lines returned
from the server are printed to the filehandle C<FH>.

=item getfh ( MSGNUM )

As per get(), but returns a tied filehandle.  Reading from this
filehandle returns the requested message.  The filehandle will return
EOF at the end of the message and should not be reused.

=item last ()

Returns the highest C<MSGNUM> of all the messages accessed.

=item popstat ()

Returns a list of two elements. These are the number of undeleted
elements and the size of the mbox in octets.

=item ping ( USER )

Returns a list of two elements. These are the number of new messages
and the total number of messages for C<USER>.

=item uidl ( [ MSGNUM ] )

Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
given C<uidl> returns a reference to a hash where the keys are the
message numbers and the values are the unique identifiers.

=item delete ( MSGNUM )

Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
that are marked to be deleted will be removed from the remote mailbox
when the server connection closed.

=item reset ()

Reset the status of the remote POP3 server. This includes reseting the
status of all messages to not be deleted.

=item quit ()

Quit and close the connection to the remote POP3 server. Any messages marked
as deleted will be deleted from the remote mailbox.

=back

=head1 NOTES

If a C<Net::POP3> object goes out of scope before C<quit> method is called
then the C<reset> method will called before the connection is closed. This
means that any messages marked to be deleted will not be.

=head1 SEE ALSO

L<Net::Netrc>,
L<Net::Cmd>

=head1 AUTHOR

Graham Barr <gbarr@pobox.com>

=head1 COPYRIGHT

Copyright (c) 1995-1997 Graham Barr. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=for html <hr>

I<$Id: //depot/libnet/Net/POP3.pm#22 $>

=cut
Commit	Line	Data
406c51ee JH	1	# Net::POP3.pm
	2	#
	3	# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
	4	# This program is free software; you can redistribute it and/or
	5	# modify it under the same terms as Perl itself.
	6
	7	package Net::POP3;
	8
	9	use strict;
	10	use IO::Socket;
	11	use vars qw(@ISA $VERSION $debug);
	12	use Net::Cmd;
	13	use Carp;
	14	use Net::Config;
	15
12df23ee	16	$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $
406c51ee JH	17
	18	@ISA = qw(Net::Cmd IO::Socket::INET);
	19
	20	sub new
	21	{
	22	my $self = shift;
	23	my $type = ref($self) \|\| $self;
	24	my $host = shift if @_ % 2;
	25	my %arg = @_;
	26	my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts};
	27	my $obj;
	28	my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): ();
	29
	30	my $h;
	31	foreach $h (@{$hosts})
	32	{
	33	$obj = $type->SUPER::new(PeerAddr => ($host = $h),
	34	PeerPort => $arg{Port} \|\| 'pop3(110)',
	35	Proto => 'tcp',
	36	@localport,
	37	Timeout => defined $arg{Timeout}
	38	? $arg{Timeout}
	39	: 120
	40	) and last;
	41	}
	42
	43	return undef
	44	unless defined $obj;
	45
	46	${*$obj}{'net_pop3_host'} = $host;
	47
	48	$obj->autoflush(1);
	49	$obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
	50
	51	unless ($obj->response() == CMD_OK)
	52	{
	53	$obj->close();
	54	return undef;
	55	}
	56
	57	${*$obj}{'net_pop3_banner'} = $obj->message;
	58
	59	$obj;
	60	}
	61
	62	##
	63	## We don't want people sending me their passwords when they report problems
	64	## now do we :-)
	65	##
	66
	67	sub debug_text { $_[2] =~ /^(pass\|rpop)/i ? "$1 ....\n" : $_[2]; }
	68
	69	sub login
	70	{
	71	@_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
	72	my($me,$user,$pass) = @_;
	73
12df23ee GB	74	if (@_ <= 2) {
	75	($user, $pass) = $me->_lookup_credentials($user);
	76	}
406c51ee JH	77
	78	$me->user($user) and
	79	$me->pass($pass);
	80	}
	81
	82	sub apop
	83	{
	84	@_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
	85	my($me,$user,$pass) = @_;
	86	my $banner;
12df23ee GB	87	my $md;
	88
	89	if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
	90	$md = Digest::MD5->new();
	91	} elsif (eval { local $SIG{__DIE__}; require MD5 }) {
	92	$md = MD5->new();
	93	} else {
	94	carp "You need to install Digest::MD5 or MD5 to use the APOP command";
406c51ee	95	return undef;
12df23ee	96	}
406c51ee JH	97
	98	return undef
	99	unless ( $banner = (${$me}{'net_pop3_banner'} =~ /(<.>)/)[0] );
	100
12df23ee GB	101	if (@_ <= 2) {
	102	($user, $pass) = $me->_lookup_credentials($user);
	103	}
406c51ee	104
406c51ee JH	105	$md->add($banner,$pass);
	106
	107	return undef
	108	unless($me->_APOP($user,$md->hexdigest));
	109
12df23ee	110	$me->_get_mailbox_count();
406c51ee JH	111	}
	112
	113	sub user
	114	{
	115	@_ == 2 or croak 'usage: $pop3->user( USER )';
	116	$_[0]->_USER($_[1]) ? 1 : undef;
	117	}
	118
	119	sub pass
	120	{
	121	@_ == 2 or croak 'usage: $pop3->pass( PASS )';
	122
	123	my($me,$pass) = @_;
	124
	125	return undef
	126	unless($me->_PASS($pass));
	127
12df23ee	128	$me->_get_mailbox_count();
406c51ee JH	129	}
	130
	131	sub reset
	132	{
	133	@_ == 1 or croak 'usage: $obj->reset()';
	134
	135	my $me = shift;
	136
	137	return 0
	138	unless($me->_RSET);
686337f3	139
406c51ee JH	140	if(defined ${*$me}{'net_pop3_mail'})
	141	{
	142	local $_;
	143	foreach (@{${*$me}{'net_pop3_mail'}})
	144	{
	145	delete $_->{'net_pop3_deleted'};
	146	}
	147	}
	148	}
	149
	150	sub last
	151	{
	152	@_ == 1 or croak 'usage: $obj->last()';
	153
	154	return undef
	155	unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
	156
	157	return $1;
	158	}
	159
	160	sub top
	161	{
	162	@_ == 2 \|\| @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
	163	my $me = shift;
	164
	165	return undef
	166	unless $me->_TOP($_[0], $_[1] \|\| 0);
	167
	168	$me->read_until_dot;
	169	}
	170
	171	sub popstat
	172	{
	173	@_ == 1 or croak 'usage: $pop3->popstat()';
	174	my $me = shift;
	175
	176	return ()
	177	unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
	178
	179	($1 \|\| 0, $2 \|\| 0);
	180	}
	181
	182	sub list
	183	{
	184	@_ == 1 \|\| @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
	185	my $me = shift;
	186
	187	return undef
	188	unless $me->_LIST(@_);
	189
	190	if(@_)
	191	{
	192	$me->message =~ /\d+\D+(\d+)/;
	193	return $1 \|\| undef;
	194	}
686337f3	195
406c51ee JH	196	my $info = $me->read_until_dot
	197	or return undef;
	198
	199	my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
	200
	201	return \%hash;
	202	}
	203
	204	sub get
	205	{
	206	@_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
	207	my $me = shift;
	208
	209	return undef
	210	unless $me->_RETR(shift);
	211
	212	$me->read_until_dot(@_);
	213	}
	214
12df23ee GB	215	sub getfh
	216	{
	217	@_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
	218	my $me = shift;
	219
	220	return unless $me->_RETR(shift);
	221	return $me->tied_fh;
	222	}
	223
	224
	225
406c51ee JH	226	sub delete
	227	{
	228	@_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
	229	$_[0]->_DELE($_[1]);
	230	}
	231
	232	sub uidl
	233	{
	234	@_ == 1 \|\| @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
	235	my $me = shift;
	236	my $uidl;
	237
	238	$me->_UIDL(@_) or
	239	return undef;
	240	if(@_)
	241	{
	242	$uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
	243	}
	244	else
	245	{
	246	my $ref = $me->read_until_dot
	247	or return undef;
	248	my $ln;
	249	$uidl = {};
	250	foreach $ln (@$ref) {
	251	my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
	252	$uidl->{$msg} = $uid;
	253	}
	254	}
	255	return $uidl;
	256	}
	257
	258	sub ping
	259	{
	260	@_ == 2 or croak 'usage: $pop3->ping( USER )';
	261	my $me = shift;
	262
	263	return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
	264
	265	($1 \|\| 0, $2 \|\| 0);
	266	}
	267
12df23ee GB	268	sub _lookup_credentials
	269	{
	270	my ($me, $user) = @_;
	271
	272	require Net::Netrc;
	273
	274	$user \|\|= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } \|\|
	275	$ENV{NAME} \|\| $ENV{USER} \|\| $ENV{LOGNAME};
	276
	277	my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
	278	$m \|\|= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
	279
	280	my $pass = $m ? $m->password \|\| ""
	281	: "";
	282
	283	($user, $pass);
	284	}
	285
	286	sub _get_mailbox_count
	287	{
	288	my ($me) = @_;
	289	my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
	290	? $1 : ($me->popstat)[0];
	291
	292	$ret ? $ret : "0E0";
	293	}
	294
686337f3	295
406c51ee JH	296	sub _STAT { shift->command('STAT')->response() == CMD_OK }
	297	sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
	298	sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
	299	sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
	300	sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
	301	sub _RSET { shift->command('RSET')->response() == CMD_OK }
	302	sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
	303	sub _TOP { shift->command('TOP', @_)->response() == CMD_OK }
	304	sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
	305	sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
	306	sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
	307	sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
	308	sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }
	309
	310	sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
	311	sub _LAST { shift->command('LAST')->response() == CMD_OK }
	312
	313	sub quit
	314	{
	315	my $me = shift;
	316
	317	$me->_QUIT;
	318	$me->close;
	319	}
	320
	321	sub DESTROY
	322	{
	323	my $me = shift;
	324
	325	if(defined fileno($me))
	326	{
	327	$me->reset;
	328	$me->quit;
	329	}
	330	}
	331
	332	##
	333	## POP3 has weird responses, so we emulate them to look the same :-)
	334	##
	335
	336	sub response
	337	{
	338	my $cmd = shift;
	339	my $str = $cmd->getline() \|\| return undef;
	340	my $code = "500";
	341
	342	$cmd->debug_print(0,$str)
	343	if ($cmd->debug);
	344
	345	if($str =~ s/^\+OK\s+//io)
	346	{
	347	$code = "200"
	348	}
	349	else
	350	{
	351	$str =~ s/^-ERR\s+//io;
	352	}
	353
	354	${*$cmd}{'net_cmd_resp'} = [ $str ];
	355	${*$cmd}{'net_cmd_code'} = $code;
	356
	357	substr($code,0,1);
	358	}
	359
360	1;
361
362	__END__
363
364	=head1 NAME
365
12df23ee	366	Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
406c51ee JH	367
	368	=head1 SYNOPSIS
	369
	370	use Net::POP3;
686337f3	371
406c51ee JH	372	# Constructors
	373	$pop = Net::POP3->new('pop3host');
	374	$pop = Net::POP3->new('pop3host', Timeout => 60);
	375
	376	=head1 DESCRIPTION
	377
	378	This module implements a client interface to the POP3 protocol, enabling
	379	a perl5 application to talk to POP3 servers. This documentation assumes
12df23ee	380	that you are familiar with the POP3 protocol described in RFC1939.
406c51ee JH	381
	382	A new Net::POP3 object must be created with the I<new> method. Once
	383	this has been done, all POP3 commands are accessed via method calls
	384	on the object.
	385
	386	=head1 EXAMPLES
	387
	388	Need some small examples in here :-)
	389
	390	=head1 CONSTRUCTOR
	391
	392	=over 4
	393
	394	=item new ( [ HOST, ] [ OPTIONS ] )
	395
	396	This is the constructor for a new Net::POP3 object. C<HOST> is the
	397	name of the remote host to which a POP3 connection is required.
	398
	399	If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
	400	will be used.
	401
	402	C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
	403	Possible options are:
	404
	405	B<ResvPort> - If given then the socket for the C<Net::POP3> object
	406	will be bound to the local port given using C<bind> when the socket is
	407	created.
	408
	409	B<Timeout> - Maximum time, in seconds, to wait for a response from the
	410	POP3 server (default: 120)
	411
	412	B<Debug> - Enable debugging information
	413
	414	=back
	415
	416	=head1 METHODS
	417
	418	Unless otherwise stated all methods return either a I<true> or I<false>
	419	value, with I<true> meaning that the operation was a success. When a method
	420	states that it returns a value, failure will be returned as I<undef> or an
	421	empty list.
	422
	423	=over 4
	424
	425	=item user ( USER )
	426
	427	Send the USER command.
	428
	429	=item pass ( PASS )
	430
	431	Send the PASS command. Returns the number of messages in the mailbox.
	432
	433	=item login ( [ USER [, PASS ]] )
	434
d1be9408	435	Send both the USER and PASS commands. If C<PASS> is not given the
406c51ee JH	436	C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
	437	and username. If the username is not specified then the current user name
	438	will be used.
	439
	440	Returns the number of messages in the mailbox. However if there are no
	441	messages on the server the string C<"0E0"> will be returned. This is
	442	will give a true value in a boolean context, but zero in a numeric context.
	443
	444	If there was an error authenticating the user then I<undef> will be returned.
	445
12df23ee	446	=item apop ( [ USER [, PASS ]] )
406c51ee JH	447
406c51ee JH	448	Authenticate with the server identifying as C<USER> with password C<PASS>.
12df23ee	449	Similar to L</login>, but the password is not sent in clear text.
406c51ee	450
12df23ee GB	451	To use this method you must have the Digest::MD5 or the MD5 module installed,
12df23ee GB	452	otherwise this method will return I<undef>.
406c51ee JH	453
	454	=item top ( MSGNUM [, NUMLINES ] )
	455
	456	Get the header and the first C<NUMLINES> of the body for the message
	457	C<MSGNUM>. Returns a reference to an array which contains the lines of text
	458	read from the server.
	459
	460	=item list ( [ MSGNUM ] )
	461
	462	If called with an argument the C<list> returns the size of the message
	463	in octets.
	464
	465	If called without arguments a reference to a hash is returned. The
	466	keys will be the C<MSGNUM>'s of all undeleted messages and the values will
	467	be their size in octets.
	468
	469	=item get ( MSGNUM [, FH ] )
	470
	471	Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
	472	then get returns a reference to an array which contains the lines of
	473	text read from the server. If C<FH> is given then the lines returned
	474	from the server are printed to the filehandle C<FH>.
	475
12df23ee GB	476	=item getfh ( MSGNUM )
	477
	478	As per get(), but returns a tied filehandle. Reading from this
	479	filehandle returns the requested message. The filehandle will return
	480	EOF at the end of the message and should not be reused.
	481
406c51ee JH	482	=item last ()
	483
	484	Returns the highest C<MSGNUM> of all the messages accessed.
	485
	486	=item popstat ()
	487
	488	Returns a list of two elements. These are the number of undeleted
	489	elements and the size of the mbox in octets.
	490
	491	=item ping ( USER )
	492
	493	Returns a list of two elements. These are the number of new messages
	494	and the total number of messages for C<USER>.
	495
	496	=item uidl ( [ MSGNUM ] )
	497
	498	Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
	499	given C<uidl> returns a reference to a hash where the keys are the
	500	message numbers and the values are the unique identifiers.
	501
	502	=item delete ( MSGNUM )
	503
	504	Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
	505	that are marked to be deleted will be removed from the remote mailbox
	506	when the server connection closed.
	507
	508	=item reset ()
	509
	510	Reset the status of the remote POP3 server. This includes reseting the
	511	status of all messages to not be deleted.
	512
	513	=item quit ()
	514
	515	Quit and close the connection to the remote POP3 server. Any messages marked
	516	as deleted will be deleted from the remote mailbox.
	517
	518	=back
	519
	520	=head1 NOTES
	521
	522	If a C<Net::POP3> object goes out of scope before C<quit> method is called
	523	then the C<reset> method will called before the connection is closed. This
	524	means that any messages marked to be deleted will not be.
	525
	526	=head1 SEE ALSO
	527
12df23ee	528	L<Net::Netrc>,
406c51ee JH	529	L<Net::Cmd>
	530
	531	=head1 AUTHOR
	532
	533	Graham Barr <gbarr@pobox.com>
	534
	535	=head1 COPYRIGHT
	536
	537	Copyright (c) 1995-1997 Graham Barr. All rights reserved.
	538	This program is free software; you can redistribute it and/or modify
	539	it under the same terms as Perl itself.
	540
686337f3 JH	541	=for html <hr>
686337f3 JH	542
12df23ee	543	I<$Id: //depot/libnet/Net/POP3.pm#22 $>
686337f3	544
406c51ee	545	=cut