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.
11 use vars qw(@ISA $VERSION $debug);
16 $VERSION = "2.24"; # $Id: //depot/libnet/Net/POP3.pm#24 $
18 @ISA = qw(Net::Cmd IO::Socket::INET);
23 my $type = ref($self) || $self;
24 my $host = shift if @_ % 2;
26 my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts};
28 my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): ();
31 foreach $h (@{$hosts})
33 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
34 PeerPort => $arg{Port} || 'pop3(110)',
37 Timeout => defined $arg{Timeout}
46 ${*$obj}{'net_pop3_host'} = $host;
49 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
51 unless ($obj->response() == CMD_OK)
57 ${*$obj}{'net_pop3_banner'} = $obj->message;
63 ## We don't want people sending me their passwords when they report problems
67 sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
71 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
72 my($me,$user,$pass) = @_;
75 ($user, $pass) = $me->_lookup_credentials($user);
84 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
85 my($me,$user,$pass) = @_;
89 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
90 $md = Digest::MD5->new();
91 } elsif (eval { local $SIG{__DIE__}; require MD5 }) {
94 carp "You need to install Digest::MD5 or MD5 to use the APOP command";
99 unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
102 ($user, $pass) = $me->_lookup_credentials($user);
105 $md->add($banner,$pass);
108 unless($me->_APOP($user,$md->hexdigest));
110 $me->_get_mailbox_count();
115 @_ == 2 or croak 'usage: $pop3->user( USER )';
116 $_[0]->_USER($_[1]) ? 1 : undef;
121 @_ == 2 or croak 'usage: $pop3->pass( PASS )';
126 unless($me->_PASS($pass));
128 $me->_get_mailbox_count();
133 @_ == 1 or croak 'usage: $obj->reset()';
140 if(defined ${*$me}{'net_pop3_mail'})
143 foreach (@{${*$me}{'net_pop3_mail'}})
145 delete $_->{'net_pop3_deleted'};
152 @_ == 1 or croak 'usage: $obj->last()';
155 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
162 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
166 unless $me->_TOP($_[0], $_[1] || 0);
173 @_ == 1 or croak 'usage: $pop3->popstat()';
177 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
184 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
188 unless $me->_LIST(@_);
192 $me->message =~ /\d+\D+(\d+)/;
196 my $info = $me->read_until_dot
199 my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
206 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
210 unless $me->_RETR(shift);
212 $me->read_until_dot(@_);
217 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
220 return unless $me->_RETR(shift);
228 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
234 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
242 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
246 my $ref = $me->read_until_dot
250 foreach $ln (@$ref) {
251 my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
252 $uidl->{$msg} = $uid;
260 @_ == 2 or croak 'usage: $pop3->ping( USER )';
263 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
268 sub _lookup_credentials
270 my ($me, $user) = @_;
274 $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
275 $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};
277 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
278 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
280 my $pass = $m ? $m->password || ""
286 sub _get_mailbox_count
289 my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
290 ? $1 : ($me->popstat)[0];
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 }
310 sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
311 sub _LAST { shift->command('LAST')->response() == CMD_OK }
325 if(defined fileno($me))
333 ## POP3 has weird responses, so we emulate them to look the same :-)
339 my $str = $cmd->getline() || return undef;
342 $cmd->debug_print(0,$str)
345 if($str =~ s/^\+OK\s*//io)
351 $str =~ s/^-ERR\s*//io;
354 ${*$cmd}{'net_cmd_resp'} = [ $str ];
355 ${*$cmd}{'net_cmd_code'} = $code;
366 Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
373 $pop = Net::POP3->new('pop3host');
374 $pop = Net::POP3->new('pop3host', Timeout => 60);
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);
381 $pop->delete($msgnum);
389 This module implements a client interface to the POP3 protocol, enabling
390 a perl5 application to talk to POP3 servers. This documentation assumes
391 that you are familiar with the POP3 protocol described in RFC1939.
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
401 =item new ( [ HOST, ] [ OPTIONS ] )
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.
406 If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
409 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
410 Possible options are:
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
416 B<Timeout> - Maximum time, in seconds, to wait for a response from the
417 POP3 server (default: 120)
419 B<Debug> - Enable debugging information
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
434 Send the USER command.
438 Send the PASS command. Returns the number of messages in the mailbox.
440 =item login ( [ USER [, PASS ]] )
442 Send both the USER and PASS commands. If C<PASS> is not given the
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
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.
451 If there was an error authenticating the user then I<undef> will be returned.
453 =item apop ( [ USER [, PASS ]] )
455 Authenticate with the server identifying as C<USER> with password C<PASS>.
456 Similar to L</login>, but the password is not sent in clear text.
458 To use this method you must have the Digest::MD5 or the MD5 module installed,
459 otherwise this method will return I<undef>.
461 =item top ( MSGNUM [, NUMLINES ] )
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.
467 =item list ( [ MSGNUM ] )
469 If called with an argument the C<list> returns the size of the message
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.
476 =item get ( MSGNUM [, FH ] )
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>.
483 =item getfh ( MSGNUM )
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.
491 Returns the highest C<MSGNUM> of all the messages accessed.
495 Returns a list of two elements. These are the number of undeleted
496 elements and the size of the mbox in octets.
500 Returns a list of two elements. These are the number of new messages
501 and the total number of messages for C<USER>.
503 =item uidl ( [ MSGNUM ] )
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.
509 =item delete ( MSGNUM )
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.
517 Reset the status of the remote POP3 server. This includes reseting the
518 status of all messages to not be deleted.
522 Quit and close the connection to the remote POP3 server. Any messages marked
523 as deleted will be deleted from the remote mailbox.
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.
540 Graham Barr <gbarr@pobox.com>
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.
550 I<$Id: //depot/libnet/Net/POP3.pm#24 $>