#!/urs/bin/perl -w
use strict;
use warnings;
use IO::Socket;
use Tk;
use subs qw/read_sock/;
my $mw;
my $sel;
my $sock;
my $text;
my $line;
my $scriptname = "my_script.pl";
#some Tk
$mw = MainWindow->new();
$text = $mw->Text->pack;
my $goButton =
$mw->Button(
-text=> "Accept",
-command => \&go
)->pack(
-side=>"left",
);
#"polling" socket
$mw->repeat(50 => \&read_sock);
MainLoop;
sub read_sock{
return unless $sock;
my $hand = $sock;
my @ready = $sel->can_read(0);
return if $#ready == -1;
$hand = $ready[0];
my $numbytes = 1;
my $buf;
sysread $hand, $buf, $numbytes;
print "read a $buf\n";
$line .= $buf;
if ($buf eq "\n"){
if ($line eq "EOF\n"){
undef $sel;
undef $sock;
undef $line;
return;
}
$text->insert('end',"$line");
undef $line;
}
}
sub go{
my $ProcessObj;
require Win32;
require Win32::Process;
Win32::Process::Create($ProcessObj,
"c:\\perl\\bin\\perl.exe",
"perl $scriptname",
0,
0,
".")|| die ErrorReport();
sleep 2; # let the script time to built the socket
$sock = IO::Socket::INET->new(PeerAddr=> 'localhost:13579');
die "cannot connect: $!\n" unless defined $sock;
use IO::Select;
$sel = IO::Select->new();
$sel->add($sock);
}
####
#!/usr/bin/perl -w
use IO::Socket;
use strict;
my $socket = IO::Socket::INET->new(
Listen => 5,
Reuse => 1,
LocalPort => 13579,
Proto => 'tcp',
)||die "couldn't open socket : $!\n";
my $new_socket = $socket -> accept();
#so far so good
#if the is $something_to_say
syswrite $new_socket, "$something_to_say\n";
####
END{
syswrite $new_socket, "EOF\n";
}