package TCP::Base;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
@ISA = qw(Exporter);

@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = '0.50';

use Carp;
use FileHandle;
use Socket;

=head1 NAME

TCP::Base - manage a TCP connection

=head1 SYNOPSIS

  require TCP::Base;
  use vars qw( @ISA );
  @ISA = qw( TCP::Base );

  sub abstract_class { 0; }   # override the method which says TCP::Base
                              # should not be used to create objects directly

  sub open {   # define a method for opening this type of a connection
    ...
  }

  [add other code required for this TCP subclass]

=cut

use vars qw( %Debug );
%Debug = ();

sub Debug {
    my ($key, $min) = @_;
    $min = 1 unless defined($min);
    my ($val) = (exists($Debug{$key})) ? $Debug{$key} : $Debug{'all'};
    defined($val) && ($val >= $min);
}

### class stuff

sub abstract_class { 1; }

sub new {
  my $class = shift;

  croak "Can't create an object for abstract class $class"
    if $class->abstract_class;

  print STDERR "! creating connection for $host:$port, class $class\n"
    if Debug('class');

  my($conn) = $class->_clt_open($host, $port)
    || croak "Can't open $class connection to $host"; return undef };

  my ($self) = {};
  bless $self, $class;

  $self->open(@_) if @_;

  return $self;
}

sub DESTROY {
    my ($self) = @_;
    print STDERR "! destroying connection for $self->{host}:$self->{port}\n"
	if Debug('class');
    $self->_dump if Debug('class', 10);
    $self->{sock}->close;
}


sub _pending {
    my ($self, $delay) = @_;
    my ($fsock) = ($self->{sock})->fileno;

    $delay = $self->{select_wait} unless defined($delay);
    undef $delay if ($delay < 0);

    my ($rin, $rout, $eout) = '';
    vec($rin, $fsock,1) = 1;

    print STDERR "# (select'ing: ". unpack("H*", $rin) .")\n"
	if Debug('select', 2);

    my ($found) = select ($rout=$rin, undef, $eout=$rin, $delay);

    print STDERR "# select: $found ". unpack("H*", $eout) ." ".
	unpack("H*", $rout) ."\n" if Debug('select', 2);
    ($found >= 0) || die "select(): $!";

    $eout = vec($eout, $fsock,1);
    $rout = vec($rout, $fsock,1);

    print STDERR "# select: ". ($found ? '' : 'not ') ."ready (".
          ($eout ? '' : 'no ') ."OOB, ". ($rout ? '' : 'no ') ."regular)\n"
	if Debug('select');

    ($eout << 1) | ($rout);
}

sub _read {
    my ($self, $size) = @_;
    $size ||= $self->{bufsize};
    my ($sock) = $self->{sock};
    my ($buf, $ret) = '';

    if (defined( $ret = sysread $sock, $buf, $size )) {
	$ret || ($self->{closed}=1);
    } else {
	carp ('sysread() for ' . ref($self) . ': ' . $!);
    }

    print STDERR "* read ". length($buf) ." bytes (tried $size) for fd ".
	$sock->fileno .": $ret\n" if Debug('read');
    $buf;
}

sub _read_2buf {
    my ($self, $delay) = @_;
    my ($pend) = $self->_pending($delay);

    if ($pend & 0x02) {
	warn "OOB data not supported";
	undef;
    } elsif ($pend) {
	$self->{buffer} .= $self->_read();
    }
}

sub eof {
    $_[0]->{closed};
}

sub _data {
    my ($self) = @_;

    print STDERR "# size(buf): ". length($self->{buffer}) ."-> 0\n"
	if Debug('buffering');
    my ($tmp) = $self->{buffer};
    $self->{buffer} = '';
    $tmp;
}

sub getline {
    my ($self, $delay) = @_;

    print STDERR "# size(buf)= ". length($self->{buffer}) ."\n"
	if Debug('buffering', 2);

    # if we have a full line of data buffered, use it.
    ($self->{buffer} =~ /\n/)
	# if we don't, read some more.
	|| ($self->_read_2buf($delay) =~ /\n/)
	    # if we read 0 bytes, assume EOF and dump the rest of data.
	    || ($self->{closed} && return $self->_data)
		# if we're waiting for more data before \n, return undef.
		|| return undef;

    print STDERR "# size(buf): ". length($self->{buffer}) ."->".
	length($') ."\n" if Debug('buffering');
    $self->{buffer} = $';
    $` . "\n";
}

sub have_data {
    my ($self, $delay) = @_;

    if ($self->{buffer}) {
	print STDERR "# (have buffered data)\n" if Debug('buffering');
	return 0x10;
    }
    $self->_pending($delay);
}

sub _write {
    my ($self, $data) = @_;
    my ($sock) = $self->{sock};
    my ($len, $ret) = length($data);

    if ($len != ($ret = syswrite $sock, $data, $len)) {
	carp ('syswrite() for ' . ref($self) . ": $ret vs $len: $!");
	return undef;
    }

    print STDERR "* wrote $ret bytes (tried $len) for fd ".
	$sock->fileno ."\n" if Debug('write');

    $ret;
}

sub print {
    my ($self, @args) = @_;
    @args = $_ unless @args;

    $self->_write( join('', @args ) );
}

sub printf {
    my ($self, $fmt, @args) = @_;
    @args = $_ unless @args;

    $self->_write( sprintf $fmt, @args );
}

1;
__END__

=head1 DESCRIPTION

=head1 AUTHOR

Albert Dvornik, bert@mit.edu

=head1 SEE ALSO

=cut