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