package Poppy;

# FIXME: When file goes out of scope, should auto close connection

$Poppy::VERSION = '1.01'; 
use IO::Socket;

sub debug {
    my $self = shift;
    my $level = shift;

    if (!defined($level)) {
        return $self->{debug};
    }

    $self->{debug} = $level;
}

sub is_pop3 {
    my $self = shift;

    if ($self->{server_proto} eq "pop3") {
        return 1;
    }
    else {
        return 0;
    }
}

sub is_imap {
    my $self = shift;

    if ($self->{server_proto} eq "imap") {
        return 1;
    }
    else {
        return 0;
    }
}

# Used internally to print interesting stuff.  This will only print
# to STDERR if the debug level has been set to a non-zero value.
sub _debug_print {
    my $self = shift;

    if ($self->{debug}) {
        print STDERR @_;
    }
}

sub connect {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my $self = {
        debug => Quiet,
        last_header => "",
        last_header_num => 0,
        @_
    };
    bless $self, $class;
    

    unless ($self->{server_port}) {
        if ($self->{server_proto} eq "pop3") {
            $self->{server_port} = "110";
        }
    }
    unless ($self->{server_proto}) {
        if ($self->{server_port} eq "110" || $self->{port} eq "pop3") {
            $self->{server_proto} = "pop3";
        }
    }
    unless ($self->{server_port}) {
        if ($self->{server_proto} eq "imap") {
            $self->{server_port} = "143";
        }
    }
    unless ($self->{server_proto}) {
        if ($self->{server_port} eq "143" || $self->{port} eq "imap") {
            $self->{server_proto} = "imap";
        }
    }

    my $ok;

    if ($self->is_pop3()) {
        $ok = $self->_connect_pop3();
    }
    else {
        $ok = $self->_connect_imap();
    }

    return undef unless ($ok);
    return $self;
}

# Sends a command to server and returns after acknowledgement
sub _pop3_command {
    my $self = shift;

    $self->_debug_print(@_, "\n");
    # POP3 requires commands to end in CRLF
    print { $self->{SOCKET} } @_,  "\r\n";

    (my $ok, my $msg) = $self->_pop3_waitforack();

    return ($ok, $msg);
}

# Waits until OK or ERR acknowledgement is detected.
sub _pop3_waitforack {
    my $self = shift;
    my ($status, $smsg);

    # Search for common POP3 acknowledgment
    $search_pattern="^.\(OK|ERR\)\(.*\)";

    $_ = $self->{SOCKET}->getline();
    if (!defined($_)) {
        return (0, "Lost connection to server");
    }
    $self->_debug_print($_);

    until (($status, $smsg) = /$search_pattern/) {
        $_ = $self->{SOCKET}->getline();
        if (!defined($_)) {
            return (0, "Lost connection to server");
        }
        $self->_debug_print($_);
    }

    my $ok = 1;
    if ($status ne "OK") {
        $ok = 0;
    }

    return ($ok, $smsg);
}

# Connects to a POP3 server.  Returns 0 on success, 1 on failure
sub _connect_pop3
{
    my $self = shift;

    my $sock = IO::Socket::INET->new(
       PeerAddr => $self->{server_name},
       PeerPort => $self->{server_port}||'pop3(110)',
       Proto => 'tcp',
       Timeout => 0,
    );

    return 0 unless(defined($sock));

    $self->{SOCKET} = $sock;

    (my $ok, my $msg) = $self->_pop3_waitforack();
    unless ($ok) {
        $self->_debug_print("Negative greeting: $msg\n"); # Should not happen
        return 0;
    }

    ($ok, $msg) = $self->_pop3_command("USER $self->{user_name}");
    return 0 unless($ok);

    # Perform manually to prevent password from being echoed to screen
    $self->_debug_print("PASS ....\n");
    print { $self->{SOCKET} } "PASS $self->{user_pass}\r\n";
    ($ok, $msg) = $self->_pop3_waitforack();

    return 0 unless ($ok);
    return 1;
}

# Sends a command to the server, waits until a tag acknowledge is received
sub _imap_command {
    my $self = shift;

    $self->_debug_print("POPPY ", @_, "\n");
    # IMAP requires commands to end in CRLF
    print { $self->{SOCKET} } "POPPY ", @_,  "\r\n";

    (my $ok, my $msg) = $self->_imap_waitforack();

    return ($ok, $msg);
}

# Waits until a OK, NO, or BAD response is received
sub _imap_waitforack {
    my $self = shift;
    my ($status, $smsg);

    # Search for common IMAP acknowledgment
    $search_pattern="^\(^POPPY OK|^POPPY NO|^POPPY BAD\)\(.*\)";

    $_ = $self->{SOCKET}->getline();
    $self->_debug_print($_);

    until (($status, $smsg) = /$search_pattern/) {
        if (eof $self->{SOCKET}) {
            return (0, "Lost connection to server");
        }
        $_ = $self->{SOCKET}->getline();
        $self->_debug_print($_);
    }

    my $ok = 1;
    $ok = 0 if ($status eq "POPPY NO" || $status eq "POPPY BAD");

    return ($ok, $smsg);
}

# Sends IMAP command to server and returns after receiving OK, NO, BAD, or
# an untagged response.
sub _imap_command_untag {
    my $self = shift;

    $self->_debug_print("POPPY ", @_, "\n");
    # IMAP requires commands to end in CRLF
    print { $self->{SOCKET} } "POPPY ", @_,  "\r\n";
}

# Waits for OK, NO, BAD, or an untagged response
sub _imap_waitforuntag {
    my $self = shift;
    my ($status, $smsg);

    # Search for common IMAP acknowledgment
    $search_pattern="^\(^[\*] |^POPPY OK|^POPPY NO|^POPPY BAD\)\(.*\)";

    $_ = $self->{SOCKET}->getline();
    $self->_debug_print($_);

    until (($status, $smsg) = /$search_pattern/) {
        if (eof $self->{SOCKET}) {
            return (0, 0, "Lost connection to server");
        }
        $_ = $self->{SOCKET}->getline();
        $self->_debug_print($_);
    }

    my $untagged = 0;
    $untagged = 1 if ($status eq "* ");

    my $ok = 1;
    $ok = 0 if ($status eq "POPPY NO" || $status eq "POPPY BAD");

    return ($ok, $untagged, $smsg);
}

# Connects to an IMAP server.  Returns 0 on success or 1 on failure
sub _connect_imap
{
    my $self = shift;

    my $sock = IO::Socket::INET->new(
       PeerAddr => $self->{server_name},
       PeerPort => $self->{server_port}||'imap(143)',
       Proto => 'tcp',
       Timeout => 0,
    );

    return 0 unless (defined($sock));

    $self->{SOCKET} = $sock;

    (my $ok, my $untagged, my $msg) = $self->_imap_waitforuntag();
    unless ($ok) {
        $self->_debug_print("Negative greeting: $msg\n"); # Should not happen
        return 0;
    }

    # Perform manually to prevent password from being echoed to screen
    $self->_debug_print("POPPY LOGIN $self->{user_name} ....\n");
    print { $self->{SOCKET} } "POPPY LOGIN $self->{user_name} \"$self->{user_pass}\"\r\n";
    ($ok, $msg) = $self->_imap_waitforack();
    return 0 unless ($ok);

    ($ok, $msg) = $self->_imap_command("SELECT INBOX");
    return 0 unless ($ok);

    # Delete all marked messages so that we can track our deletions
    # for abort purposes.
    ($ok, $msg) = $self->_imap_command("EXPUNGE");

    return 0 unless ($ok);
    return 1;
}

sub stats {
    my $self = shift;

    my $msg_count = 0;
    my $octets = 0;
    my $last_msg = 0;
    my ($ok, $untagged, $msg);
    
    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("STAT");
        return undef unless($ok);
        ($msg_count, $octets) = split(' ', $msg);

        ($ok, $msg) = $self->_pop3_command("LAST");
        # Not all POP3 servers support LAST so handle that gracefully
        if ($ok) {
            ($last_msg) = split(' ', $msg);
        } else {
            $last_msg = 0;
        }
    }
    else {
        $self->_imap_command_untag("SELECT INBOX");
        # FIXME: Handle Tagged messages in any order
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        until (!$ok || !$untagged) {
            if (/^\* (\d+) EXISTS/) { $msg_count = $1; }
            if (/^\* OK \[UNSEEN (\d+)\]/) { $last_msg = $1 - 1; }
            ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        }
        return undef unless ($ok);
        # Set last seen to last message if no UNSEEN is seen.
        $last_msg = $msg_count unless($last_msg);
    }

    return ($msg_count, $last_msg, int($octets));
}

sub delete {
    my $self = shift;
    my $msg_num = shift;
    my ($ok, $msg);

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("DELE $msg_num");
    }
    else {
        ($ok, $msg) = $self->_imap_command("STORE $msg_num +FLAGS (\\Deleted)");
    }

    return 0 unless ($ok);
    return 1;
}

sub msg_size {
    my $self = shift;
    my $msg_num = shift;
    my $octets;
    my ($ok, $untagged, $msg);

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("LIST $msg_num");
        return undef unless ($ok);
        ($msgnum, $octets) = split(' ', $msg);
    }
    else {
        $self->_imap_command_untag("FETCH $msg_num RFC822.SIZE");
        # FIXME: Handle Tagged messages in any order
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();

        until (!$ok || !$untagged) {
            if (/^.*RFC822.SIZE (\d+)\)/) { $octets = $1; }
            ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        }
        return undef unless ($ok);
    }

    return $octets; # Round up
}

# FIXME: Don't pass a value into this
sub abort_read {
    my $self = shift;
    my $value = shift;

    unless (defined($value)) {
        return $self->{abort_read};
    }

    $self->{abort_read} = $value;
}

sub last_header_num {
    my $self = shift;

    return $self->{last_header_num};
}

sub header {
    my $self = shift;
    my $msg_num = shift;
    my @msg_header;
    my ($ok, $msg);

    # If no message number is specified, return last retrieved header.
    unless (defined($msg_num)) {
        return undef unless ($self->{last_header});
        return @{$self->{last_header}};
    }

    if ($self->is_pop3()) {
        # Although not documented by RFC's, all POP3 servers
        # seem to require returning the full message header
        # so use a value of 0 with TOP command will return the full
        # header.  Also, doesn't mark the message as read.
        ($ok, $msg) = $self->_pop3_command("TOP $msg_num 0");
        return undef unless ($ok);
    }
    else {
        $self->_imap_command_untag("FETCH $msg_num RFC822.HEADER");

        # Completion response can actually come before or after
        # the actual header response.  Track whether we've read
        # completion response or not.
        my $found_tagged = 0;
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();

        until (!$ok) {
            $found_tagged = 1 unless ($untagged);

            last if (/^.*RFC822.HEADER/);
            ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        }
        return undef unless ($ok);
    }

    $_ = $self->{SOCKET}->getline();
    return undef unless (defined($_));

    until (/^\r\n$/) {
        if (/^\s/) {
            $msg_header[$#msg_header] .= $_;
        }
        else {
            push(@msg_header, $_);
        }
        $_ = $self->{SOCKET}->getline();
        return undef unless (defined($_));
    } 

    if ($self->is_pop3()) {
        # Clean out remaining buffer until we see ".\r\n"
        $_ = $self->{SOCKET}->getline();
        return undef unless (defined($_));

        until (/^.\r\n/) {
            $_ = $self->{SOCKET}->getline();
            return undef unless (defined($_));
        }
    }
    else {
        unless ($found_tag) {
            ($ok, $msg) = $self->_imap_waitforack();
            return undef unless ($ok);
        }
    }

    $self->{last_header} = [ @msg_header ];
    $self->{last_header_num} = $msg_num;
    return (@msg_header);
}

sub get_header {
    my $self = shift;
    my $search_pattern = shift;
    my @msg_header = @_;
    my @return_header;

    my $tmp = @msg_header;

    @msg_header = @{$self->{last_header}} unless (@msg_header);

    foreach my $line (@msg_header) {
        if ($line =~ /^${search_pattern}:\s/i) {

            # Change CRLF's to LF.
            $line =~ s/\r\n/\n/sg;
            # Delete last LF.
            $line =~ s/\n$//s;

            push(@return_header, $1) if ($line =~ /^${search_pattern}:\s+(.*)/si);
        }
    }
    return @return_header;
}


sub from { my $self = shift; $self->get_header("From", @_) }
sub apparently_from { my $self = shift; 
                      return $self->get_header("X-Apparently-From", @_); 
		    }
sub to { my $self = shift; return $self->get_header("To", @_); }
sub apparently_to { my $self = shift; 
                    return $self->get_header("X-Apparently-To", @_); 
		  }
sub cc { my $self = shift; return $self->get_header("Cc", @_); }
sub bcc { my $self = shift; return $self->get_header("Bcc", @_); }
sub subject { my $self = shift; return $self->get_header("Subject", @_); }
sub date { my $self = shift; return $self->get_header("Date", @_); }
sub reply_to { my $self = shift; return $self->get_header("Reply-To", @_); }
# So may sendmails use Message-Id that we query for that as well.
sub message_id { my $self = shift; 
                 my @msg_header = @_;
                 my @msg_id = $self->get_header("Message-ID", @msg_header);
		 @msg_id = $self->get_header("Message-Id", @msg_header) unless (@msg_id);
		 return @msg_id;
	       }
sub in_reply_to { my $self = shift; 
                  return $self->get_header("In-Reply-To", @_); 
		}
sub reference { my $self = shift; 
                return $self->get_header("Reference", @_); 
              }	

# Cleans up various oddities that microsoftware systems add to emails
sub _ms_cleanup {
    my $self = shift;
    my $line = shift;

    $_ = $line;

    # Clean up oddities from email sent by some Microsoft systems
    # see http://www.sf-soft.de/winhex/kb/ASCII_ISO_8859-1.html
    s/ *= *$//; s/= *20 *$//; s/=3D/=/g; s/=3H/==/g;
    s/=8B/\-/g; s/=B2/\'/g; s/=B3/\`/g; s/=B9/\'/g;
    s/=91/\`/g; s/=92/\'/g; s/=93/\`/g; s/=94/\'/g;
    s/=95/\*/g; s/=96/\-/g; s/=97/\-/g; s/=98/\~/g;
    $ps = pack("C", 0xA3);
    s/=A3/$ps/g; s/=B/\*/g;
    ## translate some Microsoft 8-bit chars to some similar 7-bit char
    tr/\221\222\223\224\225\226\227\230/`'`'*\-\-~/; #' syntax color

    return $line;
}

# Common code used to read message bodies from IMAP or POP3 servers.
sub _message_body {
    my $self = shift;
    my $fh = shift;
    my $search_pattern;

    $fh = STDOUT unless (defined($fh));

    if ($self->is_pop3()) {
        $search_pattern = "^\\.\r\n\$";
    }
    else {
        $search_pattern = "^\\)\r\n\$";
    }

    $_ = $self->{SOCKET}->getline();
    until ($_ =~ /$search_pattern/) {

        # Remove any CRLF's.
        s/\r\n$//; s/\n$//;
        s/^From />From /;  # Keeps from confusing email programs

        # FIXME: Make this optional
        $_ = $self->_ms_cleanup($_);

	print $fh "$_\n" unless ($self->{abort_read});

        $_ = $self->{SOCKET}->getline();
    }

}

sub message {
    my $self = shift;
    my $msg_num = shift;
    my $fh = shift;
    my ($ok, $untagged, $msg);

    $fh = STDOUT unless (defined($fh));

    $self->{abort_read} = 0;

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("RETR $msg_num");
        return 0 unless ($ok);
    }
    else {
        $self->_imap_command_untag("FETCH $msg_num RFC822");
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();

        until (!$ok || !$untagged) {
            last if (/^\S+\s+\S|\sFETCH.*/);
            ($failed, $untagged, $msg) = $self->_imap_waitforuntag();
        }
    }

    $self->_message_body($fh);

    return (1);
}

sub message_mbox {
    my $self = shift;
    my $msg_num = shift;
    my $fh = shift;
    my ($ok, $untagged, $msg);

    $fh = STDOUT unless (defined($fh));

    $self->{abort_read} = 0;

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("RETR $msg_num");
        return 0 unless ($ok);
    }
    else {
        $self->_imap_command_untag("FETCH $msg_num RFC822");
        # FIXME: Handle Tagged messages in any order
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();

        until (!$ok || !$untagged) {
            last if (/^\S+\s+\S|\sFETCH.*/);
            ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        }
        return 0 unless ($ok);
    }

    # Process Header first.  This is because mbox files seperate mail
    # messages with a specific form of "From" that shows who the message
    # is from and the date received.  We must parse the header before
    # writing the header so that we can use the correct From.
    my $headers = "";
    my $from;
    my $last_rcvf;
    $_ = $self->{SOCKET}->getline();
    until (/^[\r\n]*$/) {

        # Remove any CRLF's.
        s/\r\n$//; s/\n$//;

        $_ = $self->_ms_cleanup($_);

        $headers .= $_;
        $headers .= "\n";

        if (/^From:\s/ || /^X-Apparently-From:\s/) {
            # Look for From address inside <>
            if (/.*<([^>]*).*/) {
                $from = $1;
            }
            # Didn't find it so just use what ever was given.
            else {
                chop;
                s/^.*From:\s+//;
                $from = $_;
                $headers .= "\n";
            }
        }
        # In case no '@' in "From:", use host in hast "Recieved: from"
        if (/^Received:\s*from\s*(\S+).*/) {
            $last_recvf = $1;
        }

        $_ = $self->{SOCKET}->getline();
    }

    if (!$from) {
        $from = $last_recvf ? $last_recvf : "foo\@bar";
    }

    my $date = scalar(localtime());

    print $fh "From $from $date\n$headers";

    $self->_message_body($fh);

    print $fh "\n";

    return (1);
}

sub body {
    my $self = shift;
    my $msg_num = shift;
    my $fh = shift;
    my ($failed, $untagged, $msg);

    $fh = STDOUT unless (defined($fh));

    $self->{abort_read} = 0;

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("RETR $msg_num");
        return 0 unless ($ok);
    }
    else {
        # FIXME: On IMAP, you can request just the body which
        # would be faster.
        $self->_imap_command_untag("FETCH $msg_num RFC822");
        # FIXME: Handle Tagged messages in any order
        ($ok, $untagged, $msg) = $self->_imap_waitforuntag();

        until (!$ok || !$untagged) {
            last if (/^\S+\s+\S|\sFETCH.*/);
            ($ok, $untagged, $msg) = $self->_imap_waitforuntag();
        }
        return 0 unless ($ok);
    }

    # Skip past header
    $_ = $self->{SOCKET}->getline();
    until (/^[\r\n]*$/) {
        $_ = $self->{SOCKET}->getline();
    }

    $self->_message_body($fh);

    print $fh "\n";

    return (1);
}

sub abort {
    my $self = shift;
    my ($ok, $msg);

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("RSET");
    }
    else {
        ($ok, $msg) = $self->_imap_command("STORE 1:* -FLAGS (\\Deleted)");
    }

    return 0 unless ($ok);
    return 1;
}

sub disconnect {
    my $self = shift;
    my ($ok, $msg);

    if ($self->is_pop3()) {
        ($ok, $msg) = $self->_pop3_command("QUIT");
    }
    else {
        ($ok, $msg) = $self->_imap_command("CLOSE");
        return 0 unless ($ok);
        ($ok, $msg) = $self->_imap_command("LOGOUT");
    }

    close($self->{SOCKET});

    return 0 unless ($ok);
    return 1;
}

# Sends a command to server and returns after acknowledgement
sub _smtp_command {
    my $self = shift;

    $self->_debug_print(@_, "\n");
    # SMTP requires commands to end in CRLF
    print { $self->{SMTP_SOCKET} } @_,  "\r\n";

    my ($ok, $msg) = $self->_smtp_waitforack();

    return ($ok, $msg);
}

# Waits until OK or ERR acknowledgement is detected.
sub _smtp_waitforack {
    my $self = shift;
    my ($status, $smsg);

    # Search for common POP3 acknowledgment
    $search_pattern="^\([0-9][0-9][0-9]\)[ -]\(.*\)";

    $_ = $self->{SMTP_SOCKET}->getline();
    $self->_debug_print($_);

    until (($status, $smsg) = /$search_pattern/) {
        if (eof $self->{SMTP_SOCKET}) {
            return (0, "Lost connection to server");
        }
        $_ = $self->{SMTP_SOCKET}->getline();
        $self->_debug_print($_);
    }

    my $ok = 0;
    $ok = 1 if ($status =~ /211|220|221|250|354/);

    return ($ok, $smsg);
}

# Connects to a SMTP server.  Returns 0 on success, 1 on failure
sub connect_smtp
{
    my $self = shift;
    my %opt = @_;

    my $sock = IO::Socket::INET->new(
       PeerAddr => $opt{smtp_name},
       PeerPort => $opt{smtp_port}||'smtp(25)',
       Proto => 'tcp',
       Timeout => 0,
    );

    return 0 unless (defined($sock));

    $self->{SMTP_SOCKET} = $sock;

    my ($ok, $msg) = $self->_smtp_waitforack();
    unless ($ok) {
        $self->_debug_print("Negative greeting: $msg\n"); # Should not happen
        return 0;
    }

    # FIXME: This should be senders hostname, not smtp servers name!
    ($ok, $msg) = $self->_smtp_command("HELO $self->{server_name}");

    return 0 unless ($ok);
    return 1;
}

sub reply {
    my $self = shift;
    my @msg_header = @_;
    my @new_header;

    my ($from) = $self->to(@msg_header);
    my ($to) = $self->from(@msg_header);
    my ($reply_to) = $self->reply_to(@msg_header);
    my ($subject) = $self->subject(@msg_header);
    my ($msg_id) = $self->message_id(@msg_header);
    my ($ref) = $self->reference(@msg_header);
    my ($inreply_to) = $self->in_reply_to(@msg_header);

    # Remove extra Re: to prevent making string needlessly longer.
    $subject =~ s/^[Rr][Ee]: //;

    $to = $reply_to if ($reply_to);

    push(@new_header, "From: $from");
    push(@new_header, "To: $to");
    push(@new_header, "Subject: Re: $subject");
    push(@new_header, "In-Reply-To: $msg_id") if ($msg_id);
    # Add Reference using previous Reference or In-Reply-To field,
    # with Reference taking priority.  Always add Message-ID if exists.
    if ($ref || $msg_id || $inreply_to) {
        $ref = $inreply_to unless ($ref);
	if ($msg_id) {
	    if ($ref) {
	        $ref .= " ";
	    } else {
	        $ref = "";
	    }
	    $ref .= $msg_id;
	}
	push(@new_header, "Reference: $ref");
    }
    push(@new_header, "X-Mailer: poppy $Poppy::VERSION");
    return $self->send_header(@new_header);
}

sub send_header {
    my $self = shift;
    my @msg_header = @_;
    my ($from, $to);

    ($from) = $self->from(@msg_header);
    # The following is a rather incomplete assumption that all email
    # addresses will be received in a format of either 'mailbox@hostname',
    # '<mailbox@hostname>', or '"Name" <mailbox@hostname>'.  This is
    # basically how RFC822 defines it.
    # The following reduces the string to just 'mailbox@hostname' which
    # is what SMTP' RCPT command expects.
    if ($from =~ /<(.*)>/) {
        $from = $1;
    }

    # FIXME: Doesn't allow multiple destinations
    ($to) = $self->to(@msg_header);
    if ($to =~ /<(.*)>/) {
        $to = $1;
    }

    my ($ok, $msg) = $self->_smtp_command("MAIL FROM: <$from>");
    return 0 unless ($ok);

    ($ok, $msg) = $self->_smtp_command("RCPT TO: $to");
    return 0 unless ($ok);

    ($ok, $msg) = $self->_smtp_command("DATA");
    return 0 unless ($ok);

    foreach my $line (@msg_header) {
        $self->_debug_print("$line\n");
        print { $self->{SMTP_SOCKET} } "$line\r\n";
    }

    $self->_debug_print("\n");
    print { $self->{SMTP_SOCKET} } "\r\n";

    return 1;
}

sub send_file {
    my $self = shift;
    my $fh = shift;

    $fh = STDIN unless (defined($fh));

    while (<$fh>) {
        # Lines beginning with a "." must add a ".".
        if (/^\./) {
            $_ = ".$_";
        }
        $self->_debug_print($_);
        if (!/\r\n$/) {
            s/\n/\r\n/;
        }
        print { $self->{SMTP_SOCKET} } $_;
    }

    my ($ok, $msg) = $self->_smtp_command("\r\n.");

    return 0 unless ($ok);
    return 1;
}

sub send_string {
    my $self = shift;
    my $msg_str = shift;

    $msg_str =~ s/^\./\.\./gm;
    # FIXME: Need to convert \n to \r\n.  The following doesn't work
    # $msg_str =~ /\n$/\r\n/gm;
    $self->_debug_print($msg_str);
    print { $self->{SMTP_SOCKET} } $msg_str;

    my ($ok, $msg) = $self->_smtp_command("\r\n.");

    return 0 unless ($ok);
    return 1;
}

sub disconnect_smtp {
    my $self = shift;
    my ($ok, $msg);

    ($ok, $msg) = $self->_smtp_command("QUIT");

    close($self->{SMTP_SOCKET});

    return 0 unless ($ok);
    return 1;
}

1;

__END__

=head1 NAME

Poppy - General Purpose POP3/IMAP/SMTP Class

=head1 NOTE

This module is experimental.  Details of its interface are likely to
change in the future.

=head1 SYNOPSIS

    use Poppy;

    # Constructor
    $poppy = Poppy->connect(user_name => "pop3_user_name",
                            user_pass => "password",
                            server_name => "pop3_server_name",
                            server_proto => "pop3"
                            debug => 1);

    FIXME: Should use some other methods

=head1 DESCRIPTION

FIXME:

=head1 CONSTRUCTOR

=over 4

=item $poppy = Poppy->connect(%options)

describe

=back

=head1 METHODS

Unless otherwise stated all methods return either a I<true> or I<false>
value, with I<false> meaning that the operation failed.  When a method
stats that it returns a value, failure will be returned as I<undef>
or an empty list.

=over 4

=item $poppy->debug([$value])

=item $poppy->is_pop3

=item $poppy->is_imap

=item $poppy->stats

=item $poppy->delete($msg_num)

=item $poppy->msg_size($msg_num)

=item $poppy->abort_read

=item $poppy->last_header_num

=item $poppy->header($msg_num)

=item $poppy->get_header($search_pattern, [@msg_header])

FIXME: Add in predefined search patterns

=item $poppy->message($msg_num, [*FH])

=item $poppy->message_mbox($msg_num, [*FH])

=item $poppy->body($msg_num, [*FH])

=item $poppy->abort

=item $poppy->disconnect

=item $poppy->connect_smtp(%options)

=item $poppy->reply([@msg_header])

=item $poppy->send_header(@msg_header)

=item $poppy->send_file([*FH])

=item $poppy->send_str($msg_str)

=item $poppy->disconnect_smtp

=head1 AUTHOR

Chris Bagwell <chris@cnpbagwell.com>

=head1 COPYRIGHT and DISCLAIMER

This program is Copyright 2002 by Chris Bagwell. All
rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of either: a) the GNU General Public License as
published by the Free Software Foundation; either version 1, or (at
your option) any later version, or b) the "Artistic License" which
comes with Perl.

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 either the
GNU General Public License or the Artistic License for more details.

=cut