#!/usr/local/bin/perl -w

# XXX Does not work:
# "Bad arg length for Socket::pack_sockaddr_in, length is 9, should be 4"

use IO::Socket;
use Tk::IO;
use Tk;
my $mw = MainWindow->new;

my $server = IO::Socket::INET->new(Listen => 5, LocalAddr => 'localhost', Proto => 'tcp');
Tk::IO::make_nonblock($server,$smode,$snew);
$mw->fileevent($server, 'readable', [\&server_acceptable,$server,'r']);
# $mw->fileevent($server, 'writeable', [\&server_acceptable,$server,'w']);

my $port = $server->sockport;

print "Port=$port\n";

my $client = IO::Socket::INET->new;

$client->socket(AF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]) || warn "Cannot socket:$!";
Tk::IO::make_nonblock($client,$cmode,$cnew);
$client->connect($port,'localhost') || warn "Cannot connect:$! ".($!+0);

my $h = IO::Socket::INET->new;
while (1)
 {
  last if accept($h,$server);
  warn "accept $! ".($!+0);
  $client->sockport;
  die "accept $! ".($!+0) unless ($! == 11);
  sleep(1);
 }


# my $h = $server->accept or warn "accept $! ".($!+0);
print 'h peer=',$h->peerport,' sock=',$h->sockport,"\n";
print 'c peer=',$client->peerport,' sock=',$client->sockport,"\n";

exit;

$mw->fileevent( $client, 'writeable', [\&client_writeable,$client]);
$mw->fileevent( $client, 'readable', [\&client_readable, $client]);

MainLoop;

sub client_readable
{
 print 'cr(',join(',',@_),")\n";
 my $data = <$client>;
 print "cr:$data";
 $client->close;
}

sub client_writable
{
 print 'cw(',join(',',@_),")\n";
 my $client = shift;
 print $client "Hello\n";
}

sub server_acceptable
{
 print 'sa(',join(',',@_),")\n";
 my $server = shift;
 my $h = $server->accept;
 $mw->fileevent($h, 'readable', [\&server_readable,$h]);
 print "New socket ",$h->fileno,"\n";
}

sub server_readable
{
 print 'sr(',join(',',@_),")\n";
 my $h = shift;
 my $data = <$client>;
 if (defined $data)
  {
   print "cr:$data";
   print $h "ACK:$data";
  }
 else
  {
   $h->close;
  }
}