[p5sagit/p5-mst-13.2.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.24"; # $Id: //depot/libnet/Net/POP3.pm#24 $

@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);

    if ($pop->login($username, $password) > 0) {
      my $msgnums = $pop->list; # hashref of msgnum => size
      foreach my $msgnum (keys %$msgnums) {
        my $msg = $pop->get($msgnum);
        print @$msg;
        $pop->delete($msgnum);
      }
    }

    $pop->quit;

=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 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#24 $>

=cut
Commit	Line	Data
406c51ee	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
dea4d7df	16	$VERSION = "2.24"; # $Id: //depot/libnet/Net/POP3.pm#24 $
406c51ee	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	74	if (@_ <= 2) {
	75	($user, $pass) = $me->_lookup_credentials($user);
	76	}
406c51ee	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	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	97
	98	return undef
	99	unless ( $banner = (${$me}{'net_pop3_banner'} =~ /(<.>)/)[0] );
	100
12df23ee	101	if (@_ <= 2) {
	102	($user, $pass) = $me->_lookup_credentials($user);
	103	}
406c51ee	104
406c51ee	105	$md->add($banner,$pass);
	106
	107	return undef
	108	unless($me->_APOP($user,$md->hexdigest));
	109
12df23ee	110	$me->_get_mailbox_count();
406c51ee	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	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	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	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	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	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	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	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
edd55068	345	if($str =~ s/^\+OK\s*//io)
406c51ee	346	{
	347	$code = "200"
	348	}
	349	else
	350	{
edd55068	351	$str =~ s/^-ERR\s*//io;
406c51ee	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	367
	368	=head1 SYNOPSIS
	369
	370	use Net::POP3;
686337f3	371
406c51ee	372	# Constructors
	373	$pop = Net::POP3->new('pop3host');
	374	$pop = Net::POP3->new('pop3host', Timeout => 60);
	375
dea4d7df	376	if ($pop->login($username, $password) > 0) {
	377	my $msgnums = $pop->list; # hashref of msgnum => size
	378	foreach my $msgnum (keys %$msgnums) {
	379	my $msg = $pop->get($msgnum);
	380	print @$msg;
	381	$pop->delete($msgnum);
	382	}
	383	}
	384
	385	$pop->quit;
	386
406c51ee	387	=head1 DESCRIPTION
	388
	389	This module implements a client interface to the POP3 protocol, enabling
	390	a perl5 application to talk to POP3 servers. This documentation assumes
12df23ee	391	that you are familiar with the POP3 protocol described in RFC1939.
406c51ee	392
	393	A new Net::POP3 object must be created with the I<new> method. Once
	394	this has been done, all POP3 commands are accessed via method calls
	395	on the object.
	396
406c51ee	397	=head1 CONSTRUCTOR
	398
	399	=over 4
	400
	401	=item new ( [ HOST, ] [ OPTIONS ] )
	402
	403	This is the constructor for a new Net::POP3 object. C<HOST> is the
	404	name of the remote host to which a POP3 connection is required.
	405
	406	If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
	407	will be used.
	408
	409	C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
	410	Possible options are:
	411
	412	B<ResvPort> - If given then the socket for the C<Net::POP3> object
	413	will be bound to the local port given using C<bind> when the socket is
	414	created.
	415
	416	B<Timeout> - Maximum time, in seconds, to wait for a response from the
	417	POP3 server (default: 120)
	418
	419	B<Debug> - Enable debugging information
	420
	421	=back
	422
	423	=head1 METHODS
	424
	425	Unless otherwise stated all methods return either a I<true> or I<false>
	426	value, with I<true> meaning that the operation was a success. When a method
	427	states that it returns a value, failure will be returned as I<undef> or an
	428	empty list.
	429
	430	=over 4
	431
	432	=item user ( USER )
	433
	434	Send the USER command.
	435
	436	=item pass ( PASS )
	437
	438	Send the PASS command. Returns the number of messages in the mailbox.
	439
	440	=item login ( [ USER [, PASS ]] )
	441
d1be9408	442	Send both the USER and PASS commands. If C<PASS> is not given the
406c51ee	443	C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
	444	and username. If the username is not specified then the current user name
	445	will be used.
	446
	447	Returns the number of messages in the mailbox. However if there are no
	448	messages on the server the string C<"0E0"> will be returned. This is
	449	will give a true value in a boolean context, but zero in a numeric context.
	450
	451	If there was an error authenticating the user then I<undef> will be returned.
	452
12df23ee	453	=item apop ( [ USER [, PASS ]] )
406c51ee	454
406c51ee	455	Authenticate with the server identifying as C<USER> with password C<PASS>.
12df23ee	456	Similar to L</login>, but the password is not sent in clear text.
406c51ee	457
12df23ee	458	To use this method you must have the Digest::MD5 or the MD5 module installed,
12df23ee	459	otherwise this method will return I<undef>.
406c51ee	460
	461	=item top ( MSGNUM [, NUMLINES ] )
	462
	463	Get the header and the first C<NUMLINES> of the body for the message
	464	C<MSGNUM>. Returns a reference to an array which contains the lines of text
	465	read from the server.
	466
	467	=item list ( [ MSGNUM ] )
	468
	469	If called with an argument the C<list> returns the size of the message
	470	in octets.
	471
	472	If called without arguments a reference to a hash is returned. The
	473	keys will be the C<MSGNUM>'s of all undeleted messages and the values will
	474	be their size in octets.
	475
	476	=item get ( MSGNUM [, FH ] )
	477
	478	Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
	479	then get returns a reference to an array which contains the lines of
	480	text read from the server. If C<FH> is given then the lines returned
	481	from the server are printed to the filehandle C<FH>.
	482
12df23ee	483	=item getfh ( MSGNUM )
	484
	485	As per get(), but returns a tied filehandle. Reading from this
	486	filehandle returns the requested message. The filehandle will return
	487	EOF at the end of the message and should not be reused.
	488
406c51ee	489	=item last ()
	490
	491	Returns the highest C<MSGNUM> of all the messages accessed.
	492
	493	=item popstat ()
	494
	495	Returns a list of two elements. These are the number of undeleted
	496	elements and the size of the mbox in octets.
	497
	498	=item ping ( USER )
	499
	500	Returns a list of two elements. These are the number of new messages
	501	and the total number of messages for C<USER>.
	502
	503	=item uidl ( [ MSGNUM ] )
	504
	505	Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
	506	given C<uidl> returns a reference to a hash where the keys are the
	507	message numbers and the values are the unique identifiers.
	508
	509	=item delete ( MSGNUM )
	510
	511	Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
	512	that are marked to be deleted will be removed from the remote mailbox
	513	when the server connection closed.
	514
	515	=item reset ()
	516
	517	Reset the status of the remote POP3 server. This includes reseting the
	518	status of all messages to not be deleted.
	519
	520	=item quit ()
	521
	522	Quit and close the connection to the remote POP3 server. Any messages marked
	523	as deleted will be deleted from the remote mailbox.
	524
	525	=back
	526
	527	=head1 NOTES
	528
	529	If a C<Net::POP3> object goes out of scope before C<quit> method is called
	530	then the C<reset> method will called before the connection is closed. This
	531	means that any messages marked to be deleted will not be.
	532
	533	=head1 SEE ALSO
	534
12df23ee	535	L<Net::Netrc>,
406c51ee	536	L<Net::Cmd>
	537
	538	=head1 AUTHOR
	539
	540	Graham Barr <gbarr@pobox.com>
	541
	542	=head1 COPYRIGHT
	543
	544	Copyright (c) 1995-1997 Graham Barr. All rights reserved.
	545	This program is free software; you can redistribute it and/or modify
	546	it under the same terms as Perl itself.
	547
686337f3	548	=for html <hr>
686337f3	549
dea4d7df	550	I<$Id: //depot/libnet/Net/POP3.pm#24 $>
686337f3	551
406c51ee	552	=cut