This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[inseparable changes from patch from perl5.003_12 to perl5.003_13]
[perl5.git] / lib / Net / POP3.pm
1 # Net::POP3.pm
2 #
3 # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
4 # reserved. 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 =head1 NAME
10
11 Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
12
13 =head1 SYNOPSIS
14
15     use Net::POP3;
16     
17     # Constructors
18     $pop = Net::POP3->new('pop3host');
19     $pop = Net::POP3->new('pop3host', Timeout => 60);
20
21 =head1 DESCRIPTION
22
23 This module implements a client interface to the POP3 protocol, enabling
24 a perl5 application to talk to POP3 servers. This documentation assumes
25 that you are familiar with the POP3 protocol described in RFC1081.
26
27 A new Net::POP3 object must be created with the I<new> method. Once
28 this has been done, all POP3 commands are accessed via method calls
29 on the object.
30
31 =head1 EXAMPLES
32
33     Need some small examples in here :-)
34
35 =head1 CONSTRUCTOR
36
37 =over 4
38
39 =item new ( HOST, [ OPTIONS ] )
40
41 This is the constructor for a new Net::POP3 object. C<HOST> is the
42 name of the remote host to which a POP3 connection is required.
43
44 C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
45 Possible options are:
46
47 B<Timeout> - Maximum time, in seconds, to wait for a response from the
48 POP3 server (default: 120)
49
50 B<Debug> - Enable debugging information
51
52 =back
53
54 =head1 METHODS
55
56 Unless otherwise stated all methods return either a I<true> or I<false>
57 value, with I<true> meaning that the operation was a success. When a method
58 states that it returns a value, falure will be returned as I<undef> or an
59 empty list.
60
61 =over 4
62
63 =item user ( USER )
64
65 Send the USER command.
66
67 =item pass ( PASS )
68
69 Send the PASS command. Returns the number of messages in the mailbox.
70
71 =item login ( [ USER [, PASS ]] )
72
73 Send both the the USER and PASS commands. If C<PASS> is not given the
74 C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
75 and username. If the username is not specified then the current user name
76 will be used.
77
78 Returns the number of messages in the mailbox.
79
80 =item top ( MSGNUM [, NUMLINES ] )
81
82 Get the header and the first C<NUMLINES> of the body for the message
83 C<MSGNUM>. Returns a reference to an array which contains the lines of text
84 read from the server.
85
86 =item list ( [ MSGNUM ] )
87
88 If called with an argument the C<list> returns the size of the messsage
89 in octets.
90
91 If called without arguments the a refererence to a hash is returned. The
92 keys will be the C<MSGNUM>'s of all undeleted messages and the values will
93 be their size in octets.
94
95 =item get ( MSGNUM )
96
97 Get the message C<MSGNUM> from the remote mailbox. Returns a reference to an
98 array which contains the lines of text read from the server.
99
100 =item last ()
101
102 Returns the highest C<MSGNUM> of all the messages accessed.
103
104 =item popstat ()
105
106 Returns an array of two elements. These are the number of undeleted
107 elements and the size of the mbox in octets.
108
109 =item delete ( MSGNUM )
110
111 Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
112 that are marked to be deleted will be removed from the remote mailbox
113 when the server connection closed.
114
115 =item reset ()
116
117 Reset the status of the remote POP3 server. This includes reseting the
118 status of all messages to not be deleted.
119
120 =item quit ()
121
122 Quit and close the connection to the remote POP3 server. Any messages marked
123 as deleted will be deleted from the remote mailbox.
124
125 =back
126
127 =head1 NOTES
128
129 If a C<Net::POP3> object goes out of scope before C<quit> method is called
130 then the C<reset> method will called before the connection is closed. This
131 means that any messages marked to be deleted will not be.
132
133 =head1 SEE ALSO
134
135 L<Net::Netrc>
136 L<Net::Cmd>
137
138 =head1 AUTHOR
139
140 Graham Barr <Graham.Barr@tiuk.ti.com>
141
142 =head1 REVISION
143
144 $Revision: 2.1 $
145 $Date: 1996/07/26 06:44:44 $
146
147 The VERSION is derived from the revision by changing each number after the
148 first dot into a 2 digit number so
149
150         Revision 1.8   => VERSION 1.08
151         Revision 1.2.3 => VERSION 1.0203
152
153 =head1 COPYRIGHT
154
155 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
156 software; you can redistribute it and/or modify it under the same terms
157 as Perl itself.
158
159 =cut
160
161 use strict;
162 use IO::Socket;
163 use vars qw(@ISA $VERSION $debug);
164 use Net::Cmd;
165 use Carp;
166
167 $VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
168
169 @ISA = qw(Net::Cmd IO::Socket::INET);
170
171 sub new
172 {
173  my $self = shift;
174  my $type = ref($self) || $self;
175  my $host = shift;
176  my %arg  = @_; 
177  my $obj = $type->SUPER::new(PeerAddr => $host, 
178                              PeerPort => $arg{Port} || 'pop3(110)',
179                              Proto    => 'tcp',
180                              Timeout  => defined $arg{Timeout}
181                                                 ? $arg{Timeout}
182                                                 : 120
183                             ) or return undef;
184
185  ${*$obj}{'net_pop3_host'} = $host;
186
187  $obj->autoflush(1);
188  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
189
190  unless ($obj->response() == CMD_OK)
191   {
192    $obj->close();
193    return undef;
194   }
195
196  $obj;
197 }
198
199 ##
200 ## We don't want people sending me their passwords when they report problems
201 ## now do we :-)
202 ##
203
204 sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
205
206 sub login
207 {
208  @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
209  my($me,$user,$pass) = @_;
210
211  if(@_ < 2)
212   {
213    require Net::Netrc;
214
215    $user ||= (getpwuid($>))[0];
216
217    my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
218
219    $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
220
221    $pass = $m ? $m->password || ""
222               : "";
223   }
224
225  $me->user($user) and
226     $me->pass($pass);
227 }
228
229 sub user
230 {
231  @_ == 2 or croak 'usage: $pop3->user( USER )';
232  $_[0]->_USER($_[1]);
233 }
234
235 sub pass
236 {
237  @_ == 2 or croak 'usage: $pop3->pass( PASS )';
238
239  my($me,$pass) = @_;
240
241  return undef
242    unless($me->_PASS($pass));
243
244  $me->message =~ /(\d+)\s+message/io;
245
246  ${*$me}{'net_pop3_count'} = $1 || 0;
247 }
248
249 sub reset
250 {
251  @_ == 1 or croak 'usage: $obj->reset()';
252
253  my $me = shift;
254
255  return 0 
256    unless($me->_RSET);
257   
258  if(defined ${*$me}{'net_pop3_mail'})
259   {
260    local $_;
261    foreach (@{${*$me}{'net_pop3_mail'}})
262     {
263      delete $_->{'net_pop3_deleted'};
264     }
265   }
266 }
267
268 sub last
269 {
270  @_ == 1 or croak 'usage: $obj->last()';
271
272  return undef
273     unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
274
275  return $1;
276 }
277
278 sub top
279 {
280  @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
281  my $me = shift;
282
283  return undef
284     unless $me->_TOP($_[0], $_[1] || 0);
285
286  $me->read_until_dot;
287 }
288
289 sub popstat
290 {
291  @_ == 1 or croak 'usage: $pop3->popstat()';
292  my $me = shift;
293
294  return ()
295     unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
296
297  ($1 || 0, $2 || 0);
298 }
299
300 sub list
301 {
302  @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
303  my $me = shift;
304
305  return undef
306     unless $me->_LIST(@_);
307
308  if(@_)
309   {
310    $me->message =~ /\d+\D+(\d+)/;
311    return $1 || undef;
312   }
313  
314  my $info = $me->read_until_dot;
315  my %hash = ();
316  map { /(\d+)\D+(\d+)/; $hash{$1} = $2; } @$info;
317
318  return \%hash;
319 }
320
321 sub get
322 {
323  @_ == 2 or croak 'usage: $pop3->get( MSGNUM )';
324  my $me = shift;
325
326  return undef
327     unless $me->_RETR(@_);
328
329  $me->read_until_dot;
330 }
331
332 sub delete
333 {
334  @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
335  $_[0]->_DELE($_[1]);
336 }
337
338 sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
339 sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
340 sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
341 sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
342 sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
343 sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
344 sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
345 sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
346 sub _RSET { shift->command('RSET')->response() == CMD_OK }
347 sub _LAST { shift->command('LAST')->response() == CMD_OK }
348 sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
349 sub _STAT { shift->command('STAT')->response() == CMD_OK }
350
351 sub close
352 {
353  my $me = shift;
354
355  return 1
356    unless (ref($me) && defined fileno($me));
357
358  $me->_QUIT && $me->SUPER::close;
359 }
360
361 sub quit    { shift->close }
362
363 sub DESTROY
364 {
365  my $me = shift;
366
367  if(fileno($me))
368   {
369    $me->reset;
370    $me->quit;
371   }
372 }
373
374 ##
375 ## POP3 has weird responses, so we emulate them to look the same :-)
376 ##
377
378 sub response
379 {
380  my $cmd = shift;
381  my $str = $cmd->getline() || return undef;
382  my $code = "500";
383
384  $cmd->debug_print(0,$str)
385    if ($cmd->debug);
386
387  if($str =~ s/^\+OK\s+//io)
388   {
389    $code = "200"
390   }
391  else
392   {
393    $str =~ s/^\+ERR\s+//io;
394   }
395
396  ${*$cmd}{'net_cmd_resp'} = [ $str ];
397  ${*$cmd}{'net_cmd_code'} = $code;
398
399  substr($code,0,1);
400 }
401
402 1;