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.22"; # $Id: //depot/libnet/Net/POP3.pm#19 $
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) = @_;
78 $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
80 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
82 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
84 $pass = $m ? $m->password || ""
94 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
95 my($me,$user,$pass) = @_;
98 unless(eval { require MD5 })
100 carp "You need to install MD5 to use the APOP command";
105 unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
111 $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
113 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
115 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
117 $pass = $m ? $m->password || ""
122 $md->add($banner,$pass);
125 unless($me->_APOP($user,$md->hexdigest));
127 my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
128 ? $1 : ($me->popstat)[0];
135 @_ == 2 or croak 'usage: $pop3->user( USER )';
136 $_[0]->_USER($_[1]) ? 1 : undef;
141 @_ == 2 or croak 'usage: $pop3->pass( PASS )';
146 unless($me->_PASS($pass));
148 my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
149 ? $1 : ($me->popstat)[0];
156 @_ == 1 or croak 'usage: $obj->reset()';
163 if(defined ${*$me}{'net_pop3_mail'})
166 foreach (@{${*$me}{'net_pop3_mail'}})
168 delete $_->{'net_pop3_deleted'};
175 @_ == 1 or croak 'usage: $obj->last()';
178 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
185 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
189 unless $me->_TOP($_[0], $_[1] || 0);
196 @_ == 1 or croak 'usage: $pop3->popstat()';
200 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
207 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
211 unless $me->_LIST(@_);
215 $me->message =~ /\d+\D+(\d+)/;
219 my $info = $me->read_until_dot
222 my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
229 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
233 unless $me->_RETR(shift);
235 $me->read_until_dot(@_);
240 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
246 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
254 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
258 my $ref = $me->read_until_dot
262 foreach $ln (@$ref) {
263 my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
264 $uidl->{$msg} = $uid;
272 @_ == 2 or croak 'usage: $pop3->ping( USER )';
275 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
281 sub _STAT { shift->command('STAT')->response() == CMD_OK }
282 sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
283 sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
284 sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
285 sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
286 sub _RSET { shift->command('RSET')->response() == CMD_OK }
287 sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
288 sub _TOP { shift->command('TOP', @_)->response() == CMD_OK }
289 sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
290 sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
291 sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
292 sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
293 sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }
295 sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
296 sub _LAST { shift->command('LAST')->response() == CMD_OK }
310 if(defined fileno($me))
318 ## POP3 has weird responses, so we emulate them to look the same :-)
324 my $str = $cmd->getline() || return undef;
327 $cmd->debug_print(0,$str)
330 if($str =~ s/^\+OK\s+//io)
336 $str =~ s/^-ERR\s+//io;
339 ${*$cmd}{'net_cmd_resp'} = [ $str ];
340 ${*$cmd}{'net_cmd_code'} = $code;
351 Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
358 $pop = Net::POP3->new('pop3host');
359 $pop = Net::POP3->new('pop3host', Timeout => 60);
363 This module implements a client interface to the POP3 protocol, enabling
364 a perl5 application to talk to POP3 servers. This documentation assumes
365 that you are familiar with the POP3 protocol described in RFC1081.
367 A new Net::POP3 object must be created with the I<new> method. Once
368 this has been done, all POP3 commands are accessed via method calls
373 Need some small examples in here :-)
379 =item new ( [ HOST, ] [ OPTIONS ] )
381 This is the constructor for a new Net::POP3 object. C<HOST> is the
382 name of the remote host to which a POP3 connection is required.
384 If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
387 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
388 Possible options are:
390 B<ResvPort> - If given then the socket for the C<Net::POP3> object
391 will be bound to the local port given using C<bind> when the socket is
394 B<Timeout> - Maximum time, in seconds, to wait for a response from the
395 POP3 server (default: 120)
397 B<Debug> - Enable debugging information
403 Unless otherwise stated all methods return either a I<true> or I<false>
404 value, with I<true> meaning that the operation was a success. When a method
405 states that it returns a value, failure will be returned as I<undef> or an
412 Send the USER command.
416 Send the PASS command. Returns the number of messages in the mailbox.
418 =item login ( [ USER [, PASS ]] )
420 Send both the the USER and PASS commands. If C<PASS> is not given the
421 C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
422 and username. If the username is not specified then the current user name
425 Returns the number of messages in the mailbox. However if there are no
426 messages on the server the string C<"0E0"> will be returned. This is
427 will give a true value in a boolean context, but zero in a numeric context.
429 If there was an error authenticating the user then I<undef> will be returned.
431 =item apop ( USER, PASS )
433 Authenticate with the server identifying as C<USER> with password C<PASS>.
434 Similar ti L<login>, but the password is not sent in clear text.
436 To use this method you must have the MD5 package installed, if you do not
437 this method will return I<undef>
440 =item top ( MSGNUM [, NUMLINES ] )
442 Get the header and the first C<NUMLINES> of the body for the message
443 C<MSGNUM>. Returns a reference to an array which contains the lines of text
444 read from the server.
446 =item list ( [ MSGNUM ] )
448 If called with an argument the C<list> returns the size of the message
451 If called without arguments a reference to a hash is returned. The
452 keys will be the C<MSGNUM>'s of all undeleted messages and the values will
453 be their size in octets.
455 =item get ( MSGNUM [, FH ] )
457 Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
458 then get returns a reference to an array which contains the lines of
459 text read from the server. If C<FH> is given then the lines returned
460 from the server are printed to the filehandle C<FH>.
464 Returns the highest C<MSGNUM> of all the messages accessed.
468 Returns a list of two elements. These are the number of undeleted
469 elements and the size of the mbox in octets.
473 Returns a list of two elements. These are the number of new messages
474 and the total number of messages for C<USER>.
476 =item uidl ( [ MSGNUM ] )
478 Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
479 given C<uidl> returns a reference to a hash where the keys are the
480 message numbers and the values are the unique identifiers.
482 =item delete ( MSGNUM )
484 Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
485 that are marked to be deleted will be removed from the remote mailbox
486 when the server connection closed.
490 Reset the status of the remote POP3 server. This includes reseting the
491 status of all messages to not be deleted.
495 Quit and close the connection to the remote POP3 server. Any messages marked
496 as deleted will be deleted from the remote mailbox.
502 If a C<Net::POP3> object goes out of scope before C<quit> method is called
503 then the C<reset> method will called before the connection is closed. This
504 means that any messages marked to be deleted will not be.
513 Graham Barr <gbarr@pobox.com>
517 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
518 This program is free software; you can redistribute it and/or modify
519 it under the same terms as Perl itself.
523 I<$Id: //depot/libnet/Net/POP3.pm#19 $>