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