# Pop3.pm --- interact with pop3 servers

# Copyright (C) 1996, 1999 Noah S. Friedman

# Author: Noah Friedman <friedman@splode.com>
# Created: 1996-10-18

# $Id: Pop3.pm,v 1.4 2000/02/11 11:29:51 friedman Exp $

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, you can either send email to this
# program's maintainer or write to: The Free Software Foundation,
# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

# Commentary:
# Code:

package NF::Pop3;

use strict;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT_OK   = qw();
@EXPORT      = qw();


sub pop3_login ($$$)
{
  my ($sock, $login, $pass) = @_;

  # greeting
  return 1 if (pop3_response_ok_p ($sock)
               && pop3_send_command_ok_p ($sock, "USER " . $login)
               && pop3_send_command_ok_p ($sock, "PASS " . $pass));

  pop3_close ($sock);
  return 0;
}

sub pop3_message_count ($)
{
  my $sock = $_[0];
  pop3_send_command ($sock, "STAT");
  my $results = pop3_parse_response ($sock);
  return $results->[1];
}

sub pop3_retrieve_lines ($$$)
{
  my ($sock, $msgnumber, $bodylines) = @_;
  $bodylines += 0;  # force into numeric context

  pop3_send_command ($sock, ($bodylines < 0
                             ? "RETR $msgnumber"
                             : "TOP $msgnumber $bodylines"));
  return undef unless (pop3_response_ok_p ($sock));

  my $i = 0;
  my $headers_end = 0;
  my @lines;
  while (<$sock>)
    {
      s/[\r\n]+$//o;

      # The end of the transmission always ends with a single period on a
      # line by itself.
      last if ($_ eq '.');
      # Otherwise, any period at the beginning of a line is quoted with an
      # additional period.  Periods after the first aren't quoted, so at
      # the most we need strip only one.
      s/^\.//o;

      # The first blank line signals the end of headers.
      $headers_end = $i if ($_ eq '' && $headers_end == 0);
      push @lines, $_;
      $i++;
    }

  return [ $headers_end, \@lines ];
}

sub pop3_send_command ($$)
{
  my $sock = shift;
  print $sock $_[0], "\r\n";
}

sub pop3_response_ok_p ($)
{
  my $sock = shift;
  my $response = pop3_read_response ($sock);

  return 1 if ($response =~ /^\+OK/oi);
  return 0;
}

sub pop3_send_command_ok_p ($$)
{
  my $sock = shift;
  pop3_send_command ($sock, $_[0]);
  pop3_response_ok_p ($sock);
}

sub pop3_parse_response ($)
{
  my $sock = shift;
  my $response = pop3_read_response ($sock);
  $response =~ s/[\r\n]+$//o;
  [ split (/[ \t]+/o, $response) ];
}

sub pop3_read_response ($)
{
  my $sock = shift;
  my $line = <$sock>;
  #$line =~ s/[\r\n]+$//o;
  return $line;
}

sub pop3_close ($)
{
  my $sock = shift;
  # Should we send a quit in general, or just close the connection?
  # RFC1725 section 6 says doing the latter avoids entering the UPDATE
  # state, which should avoid changing any read/unread status headers.
  # However, some pop3 servers do not make this distinction and update
  # status headers anyway.
  #pop3_send_command ($sock, 'QUIT');
  shutdown ($sock, 2);  # 2 == SHUTDOWN_BOTH
}

1;