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.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $
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);
378 This module implements a client interface to the POP3 protocol, enabling
379 a perl5 application to talk to POP3 servers. This documentation assumes
380 that you are familiar with the POP3 protocol described in RFC1939.
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
388 Need some small examples in here :-)
394 =item new ( [ HOST, ] [ OPTIONS ] )
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.
399 If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
402 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
403 Possible options are:
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
409 B<Timeout> - Maximum time, in seconds, to wait for a response from the
410 POP3 server (default: 120)
412 B<Debug> - Enable debugging information
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
427 Send the USER command.
431 Send the PASS command. Returns the number of messages in the mailbox.
433 =item login ( [ USER [, PASS ]] )
435 Send both the USER and PASS commands. If C<PASS> is not given the
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
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.
444 If there was an error authenticating the user then I<undef> will be returned.
446 =item apop ( [ USER [, PASS ]] )
448 Authenticate with the server identifying as C<USER> with password C<PASS>.
449 Similar to L</login>, but the password is not sent in clear text.
451 To use this method you must have the Digest::MD5 or the MD5 module installed,
452 otherwise this method will return I<undef>.
454 =item top ( MSGNUM [, NUMLINES ] )
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.
460 =item list ( [ MSGNUM ] )
462 If called with an argument the C<list> returns the size of the message
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.
469 =item get ( MSGNUM [, FH ] )
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>.
476 =item getfh ( MSGNUM )
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.
484 Returns the highest C<MSGNUM> of all the messages accessed.
488 Returns a list of two elements. These are the number of undeleted
489 elements and the size of the mbox in octets.
493 Returns a list of two elements. These are the number of new messages
494 and the total number of messages for C<USER>.
496 =item uidl ( [ MSGNUM ] )
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.
502 =item delete ( MSGNUM )
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.
510 Reset the status of the remote POP3 server. This includes reseting the
511 status of all messages to not be deleted.
515 Quit and close the connection to the remote POP3 server. Any messages marked
516 as deleted will be deleted from the remote mailbox.
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.
533 Graham Barr <gbarr@pobox.com>
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.
543 I<$Id: //depot/libnet/Net/POP3.pm#22 $>