#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

use Tk;
use Tk::Text;
use IO::Socket;
use Errno qw(EAGAIN);

my ($ip_addr, $line, $sock, $widget);



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 runnin
+g.
my $ent1 = $frm_name -> Entry();
my $but = $mw -> Button(-text => "Start", -command => \&start);

# Create a window for Display and Input.

my $textarea = $mw -> Frame(); #creating another frame
my $txt = $textarea -> Text(-width=>40, -height=>10);
my $srl_y = $textarea -> Scrollbar(-orient=>'v', -command=>[yview => $
+txt]);
my $srl_x = $textarea -> Scrollbar(-orient=>'h', -command=>[xview => $
+txt]);
$txt -> configure(-yscrollcommand=>['set',$srl_y], -xscrollcommand=>['
+set',$srl_x]);

$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, -columnspan=>2);

$txt -> grid(-row=>1, -column=>1);
$srl_y -> grid(-row=>1, -column=>2, -sticky=>"ns");
$srl_x -> grid(-row=>2, -column=>1, -sticky=>"ew");
$textarea -> grid(-row=>5, -column=>1, -columnspan=>2);

#my $text=$textarea->Text(qw/-width 40 -height 10/)->grid(-row=>6, -co
+lumn=>1);
#tie *STDOUT,ref $text,$text;
#print "Hello World\n";
open (Child, "STDOUT 2>&1 |") or die "Can't open Child: $!";
$textarea->fileevent (\*Child, 'readable', \&fill_text_widget);

sub fill_text_widget {
    if ( eof(Child) ) { # Child closed pipe    
    close(Child); # Close parent's part of pipe
    # filevent is canceled as well
    wait; # Avoid zombies
    return;
    }
}        


MainLoop;

sub start {

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

FORK: {
    if (my $pid = fork) {
    # parent here. 
    # STDOUT process pid is available in $pid
    print "STDOUT pid returned to parent by fork is: $pid\n";
    
    # Print all received from open socket '$sock'.
    while ( defined ($line = <$sock>) ) {
    print   $line;
    }
    }    
    elsif (defined $pid) {
    # STDOUT here
    # parent process pid is available with getppid
    print "STDOUT's pid returned by fork is: $pid\n";
    my $ppid = getppid;
    print "Parent's pid is :$ppid\n";
    # User input is sent to the open socket
    while (defined ($line = $textarea)) {
    print $sock $line;
                    } 
    }                    
     
    elsif ($! == EAGAIN) {
    # EAGAIN is the supposedly recoverable fork error
    sleep 5;
    redo FORK;
    }
    else {
    # weird fork error
    die " Can't fork: $!\n";
    }
}                

}
[download]