# -*- perl -*-
#
# $Id: TCPConnection.pm,v 1.23 1999/02/09 17:12:01 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/TCPConnection.pm,v $
# $Author: ejb $
#

require 5.004;
use strict;

package TCPConnection;
my $package = "TCPConnection";

use IO::Socket;

# Field names
my $f_socket = "socket";

my $have_sig_pipe = 1;
eval
{
    my $w = $SIG{'__WARN__'} || 'DEFAULT';
    $SIG{'__WARN__'} = sub { $have_sig_pipe = 0; };
    eval { $SIG{'PIPE'} = sub { die "--pipe--\n"; }; };
    $SIG{'__WARN__'} = $w;
};

# Routines

sub new
{
    my $class = shift;
    my $rep = +{$package => {} };

    if (@_ != 2)
    {
	die "$package: Usage: new $package(port, host)\n";
    }
    my ($remotehost, $portname) = @_;

    my $s = IO::Socket::INET->new(PeerAddr => $remotehost,
				  PeerPort => $portname,
				  Proto => 'tcp');
    $rep->{$package}{$f_socket} = $s;

    bless $rep, $class;
}

sub new_accept
{
    my $class = shift;
    my $rep = +{$package => {} };

    if (@_ != 1)
    {
	die "$package: Usage: accept $package(listener)\n";
    }
    my $l = shift;
    my $s = $l->accept();
    $rep->{$package}{$f_socket} = $s;

    bless $rep, $class;
}

sub new_listen
{
    my $class = shift;
    my $rep = +{$package => {} };

    if (@_ != 1)
    {
	die "$package: Usage: new_listen $package(port)\n";
    }
    my $portname = shift;
    my $s = IO::Socket::INET->new(Listen => 5,
				  LocalPort => $portname,
				  Proto => 'tcp');
    $rep->{$package}{$f_socket} = $s;

    bless $rep, $class;
}

sub sockname
{
    my $rep = shift;
    my $s = $rep->socket();
    unpack_sockaddr_in($s->sockname());
}

sub socket
{
    my $rep = shift;
    $rep->{$package}{$f_socket} = $_[0] if @_;
    $rep->{$package}{$f_socket};
}

sub p_print_or_printf
{
    my $rep = shift;
    my $printf = shift;
    my $s = $rep->socket();
    my $pipe;
    if ($have_sig_pipe)
    {
	$pipe = $SIG{'PIPE'};
	$SIG{'PIPE'} = sub { die "--pipe--\n"; };
    }
    eval
    {
	if ($printf)
	{
	    printf $s @_;
	}
	else
	{
	    print $s @_;
	}
    };
    my $t = $@;
    if ($have_sig_pipe)
    {
	local($^W) = 0;
	$SIG{'PIPE'} = $pipe;
    }
    ($t ? undef : 1);
}

sub print
{
    my $rep = shift;
    $rep->p_print_or_printf(0, @_);
}

sub printf
{
    my $rep = shift;
    $rep->p_print_or_printf(1, @_);
}

sub get
{
    my $rep = shift;
    my $s = $rep->socket();
    $s->getline();
}

sub read
{
    my $rep = shift;
    my $s = $rep->socket();
    read $s, $_[0], $_[1], ($_[2] || 0);
}

sub test
{
    $DB::single = 1 if defined $DB::single;
    shift;
    my $t = shift;
    $t =~ m/^(.*)\@(.*)$/ || die "$package: test arg must be x\@y\n";
    my ($u, $h) = ($1, $2);
    my $s = new TCPConnection($h, "smtp");
    $s->print("EXPN $u\n");
    $s->print("quit\n");
    while (1)
    {
	my $l = $s->get();
	last if ! defined($l);
	print $l;
    }
}

1;

#
# END OF TCPConnection
#