[p5sagit/p5-mst-13.2.git] / lib / Net / POP3.pm

# Net::POP3.pm
#
# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.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;

=head1 NAME

Net::POP3 - Post Office Protocol 3 Client class (RFC1081)

=head1 SYNOPSIS

    use Net::POP3;
    
    # Constructors
    $pop = Net::POP3->new('pop3host');
    $pop = Net::POP3->new('pop3host', Timeout => 60);

=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 RFC1081.

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 EXAMPLES

    Need some small examples in here :-)

=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.

C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
Possible options are:

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, falure 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 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.

=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 messsage
in octets.

If called without arguments the a refererence 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 )

Get the message C<MSGNUM> from the remote mailbox. Returns a reference to an
array which contains the lines of text read from the server.

=item last ()

Returns the highest C<MSGNUM> of all the messages accessed.

=item popstat ()

Returns an array of two elements. These are the number of undeleted
elements and the size of the mbox in octets.

=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 <Graham.Barr@tiuk.ti.com>

=head1 REVISION

$Revision: 2.1 $
$Date: 1996/07/26 06:44:44 $

The VERSION is derived from the revision by changing each number after the
first dot into a 2 digit number so

	Revision 1.8   => VERSION 1.08
	Revision 1.2.3 => VERSION 1.0203

=head1 COPYRIGHT

Copyright (c) 1995 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.

=cut

use strict;
use IO::Socket;
use vars qw(@ISA $VERSION $debug);
use Net::Cmd;
use Carp;

$VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};

@ISA = qw(Net::Cmd IO::Socket::INET);

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;
 my $host = shift;
 my %arg  = @_; 
 my $obj = $type->SUPER::new(PeerAddr => $host, 
			     PeerPort => $arg{Port} || 'pop3(110)',
			     Proto    => 'tcp',
			     Timeout  => defined $arg{Timeout}
						? $arg{Timeout}
						: 120
			    ) or return undef;

 ${*$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;
}

##
## 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)
  {
   require Net::Netrc;

   $user ||= (getpwuid($>))[0];

   my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);

   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});

   $pass = $m ? $m->password || ""
              : "";
  }

 $me->user($user) and
    $me->pass($pass);
}

sub user
{
 @_ == 2 or croak 'usage: $pop3->user( USER )';
 $_[0]->_USER($_[1]);
}

sub pass
{
 @_ == 2 or croak 'usage: $pop3->pass( PASS )';

 my($me,$pass) = @_;

 return undef
   unless($me->_PASS($pass));

 $me->message =~ /(\d+)\s+message/io;

 ${*$me}{'net_pop3_count'} = $1 || 0;
}

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;
 my %hash = ();
 map { /(\d+)\D+(\d+)/; $hash{$1} = $2; } @$info;

 return \%hash;
}

sub get
{
 @_ == 2 or croak 'usage: $pop3->get( MSGNUM )';
 my $me = shift;

 return undef
    unless $me->_RETR(@_);

 $me->read_until_dot;
}

sub delete
{
 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
 $_[0]->_DELE($_[1]);
}

sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
sub _RSET { shift->command('RSET')->response() == CMD_OK }
sub _LAST { shift->command('LAST')->response() == CMD_OK }
sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
sub _STAT { shift->command('STAT')->response() == CMD_OK }

sub close
{
 my $me = shift;

 return 1
   unless (ref($me) && defined fileno($me));

 $me->_QUIT && $me->SUPER::close;
}

sub quit    { shift->close }

sub DESTROY
{
 my $me = shift;

 if(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;
Commit	Line	Data
7e1af8bc	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;