#!/usr/bin/perl
    use strict;
    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
    use Socket;
    use Carp;
    use Time::HiRes;
    
    my $EOL = "\015\012";

    sub spawn;    # forward declaration
    sub logmsg { select STDERR; warn "$0 $$: @_ at ", scalar localtime, "\n" }

    my $port = shift || 2345;
    my $proto = getprotobyname('tcp');

    ($port) = $port =~ /^(\d+)$/ or die "invalid port";

    socket( Server, PF_INET, SOCK_STREAM, $proto ) || die "socket: $!";
    setsockopt( Server, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) )
      || die "setsockopt: $!";
    bind( Server, sockaddr_in( $port, INADDR_ANY ) ) || die "bind: $!";
    listen( Server, SOMAXCONN ) || die "listen: $!";

    logmsg "server started on port $port";

    my $waitedpid = 0;
    my $paddr;

    use POSIX ":sys_wait_h";
    use Errno;

    sub REAPER {
        local $!;    # don't let waitpid() overwrite current error
        while ( ( my $pid = waitpid( -1, WNOHANG ) ) > 0 && WIFEXITED($?) ) {
            logmsg "reaped $waitedpid" . ( $? ? " with exit $?" : '' );
        }
        $SIG{CHLD} = \&REAPER;    # loathe sysV
    }

    $SIG{CHLD} = \&REAPER;

    while (1) {
        $paddr = accept( Client, Server ) || do {

            # try again if accept() returned because a signal was received
            next if $!{EINTR};
            die "accept: $!";
        };
        my ( $port, $iaddr ) = sockaddr_in($paddr);
        my $name = gethostbyaddr( $iaddr, AF_INET );

        logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";

        spawn sub {
            select Client;
            $| = 1;
            while (1) {
                my $time = scalar localtime;
                print Client "Hello there, $name, it's now $time $EOL";
                Time::HiRes::sleep .2;
            }
        };
        close Client;
    }

    sub spawn {
        my $coderef = shift;
        unless ( @_ == 0 && $coderef && ref($coderef) eq 'CODE' ) {
            confess "usage: spawn CODEREF";
        }

        my $pid;
        if ( !defined( $pid = fork ) ) {
            logmsg "cannot fork: $!";
            return;
        }
        elsif ($pid) {
            logmsg "begat $pid";
            return;    # I'm the parent
        }

        # else I'm the child -- go spawn

        open( STDIN,  "<&Client" ) || die "can't dup client to stdin";
        open( STDOUT, ">&Client" ) || die "can't dup client to stdout";
        ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
        exit &$coderef();
    }

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

use Tk;
use Tk::Text;
use IO::Socket;

my ( $ip_addr, $line, $sock, $afterid, $cancel );

my $mw = new MainWindow;

# Put a Frame in it/give it a label
my $frm_name = $mw->Frame();
my $lab = $frm_name->Label( -text => "Enter IP address:port" );

# We need entry boxes for IP address:socket & a button to start running.
my $ent1    = $frm_name->Entry();
my $but     = $mw->Button( -text => "Start", -command => \&start );
my $stopbut = $mw->Button( -text => "Stop", -command => \&stop );

# Create a window for Display and Input.

my $textarea = $mw->Frame();          #creating another frame
my $txt      = $textarea->Scrolled(
    'Text',
    -width      => 80,
    -height     => 10,
    -scrollbars => 'osoe'
);
$lab->grid( -row => 1, -column => 1 );
$ent1->grid( -row => 1, -column => 2 );
$frm_name->grid( -row => 1, -column => 1, -columnspan => 2 );

$but->grid( -row => 4, -column => 1 );
$stopbut->grid( -row => 4, -column => 2 );
$txt->grid( -row => 1, -column => 1 );

$textarea->grid( -row => 5, -column => 1, -columnspan => 2 );

MainLoop;

sub start {
    return if defined $afterid;
    $cancel  = 0;
    $ip_addr = $ent1->get();
    print STDOUT "addr: $ip_addr\n";

    $sock = new IO::Socket::INET(
        PeerAddr => $ip_addr,
        PeerPort => '5000',
        Proto    => 'tcp',
    );
    die "Could not create socket: $! \n" unless $sock;

    $afterid = $mw->after(
        100,
        sub {
            while ( defined( $line = <$sock> ) ) {
                $line =~ s/\015\012/\n/;
                $txt->insert( 'end', $line );
                $txt->see('end');
                $mw->update;
                last if $cancel;
            }
        }
    );
}

sub stop {
    return unless $afterid;
    $cancel = 1;
    $afterid->cancel;
    undef $afterid;
    close $sock;
    undef $sock;
}