package Telnet;

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

require Exporter;
@ISA = qw(Exporter);

@EXPORT = qw(
	CRLF
);
@EXPORT_OK = qw(
);
$VERSION = '0.90';

use Carp;
use FileHandle;
use Socket;
use POSIX ();

sub CRLF { "\015\012" }

use vars qw ( $select_wait $bufsize );
$select_wait = 0;
$bufsize = &POSIX::BUFSIZ || 8192;

use vars qw( %Debug );
%Debug = ();
sub Debug {
    my ($key, $min) = @_;
    $min = 1 unless defined($min);
    my ($val) = $Debug{$key};
    $val = $Debug{'all'} unless defined($val);
    return 0 if !defined($val);
    $val >= $min;
}

sub _clt_open {
    my ($class, $host, $port) = @_;
    my ($iport, $iaddr, $proto, $query);

    $proto = getprotobyname('tcp');
    $iport = $port || 'telnet';
    $iport = getservbyname($iport, 'tcp') if ($iport =~ /\D/);
    $iport || do { carp "Invalid port: '$port'"; return undef  };

    print STDERR "  Connecting to $host, port $iport (proto=$proto)...\n"
	if Debug('connect');

    $iaddr = inet_aton($host)
	|| do { carp "Invalid host: '$host'"; return undef  };
    print STDERR "  Connecting to @{[inet_ntoa($iaddr)]}:$iport...\n"
	if Debug('connect', 2);

    my ($fh, $sin) = new FileHandle;
    socket($fh, PF_INET, SOCK_STREAM, $proto);
    $sin = pack_sockaddr_in($iport, $iaddr);
    connect($fh, $sin);

    my ($sockaddr) = getsockname($fh) || return undef;
    if (Debug('connect')) {
	my ($xpt, $xaddr) = unpack_sockaddr_in($sockaddr);
	print STDERR "  Connected to ". inet_ntoa($iaddr) .":". $iport .
                              " from ". inet_ntoa($xaddr) .":". $xpt ."...\n";
    }

    return $fh;
}

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 );
}

### class stuff

sub _dump {
    my ($self) = @_;
    my ($k);

    for $k (keys %$self) {
	print STDERR "~ $k => [$self->{$k}]\n";
    }
}

sub new {
    my ($class, $host, $port) = @_;
    defined($port) || ($port = 'telnet');
    print STDERR "! creating connection for $host:$port, class $class\n"
	if Debug('class');

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

    my ($self) = {};
    $self->{host}        = $host;
    $self->{port}        = $port;
    $self->{sock}        = $conn;
    $self->{buffer}      = '';
    $self->{bufsize}     = $bufsize;
    $self->{select_wait} = $select_wait;

    bless $self, $class;
    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;
}

1;
__END__

=head1 NAME

  Telnet - create a Telnet connection

=head1 SYNOPSIS

  use Telnet;
  $fh = new Telnet 'host.name.org', 'qotd';

=head1 DESCRIPTION

=head1 AUTHOR

Albert Dvornik, bert@mit.edu

=head1 SEE ALSO

=cut