I had a chance to use several of my Tk scripts in an Amateur Radio contest last weekend. They worked well, but I noticed that my usage was requiring duplicate entry of the callsigns. Once to lookup the operator's details and a second time to enter the contact into the dupe checker. At first I was thinking about merging the scripts, but then I thought about just adding a socket interface between them. After some research, I found fileevent. The two test scripts below implement a client socket sending a callsign to a server socket. The server then inserts the callsign into a Tk Textbox. This code will be integrated into the existing scripts. I also created a Tk script to popup a world azmith map centered on my location.
May my learnig curve be with you...it was enough to get me to order "Mastering Perl/Tk".
#! /usr/bin/perl
# Name: Netrecv.pl - TCP Server for Tk Socket Interface Tes
+ting
# Author: James M. Lynes, Jr. - KE4MIQ
# Created: March 7,2023
# Last Modified: March 7,2023
# Change Log: 03/07/2023 - Created from Mastering Perl/Tk ex
+amples
# and Netxmit.pl
#
#
# Description: Read callsign from Netxmit.pl(TCP Client)
# over the localhost:4532 socket. Insert
# the callsign into a Tk Text widget.
#
# Uses the Tk fileevent method to do a non-block
+ing
# socket read using the socket like a file h
+andle.
#
# Start Netrecv.pl before Netxmit.pl
#
use strict;
use warnings;
use IO::Socket::INET;
use Tk;
my $port = '4532'; # Hamlib Po
+rt(won't conflict)
print "\nNetrecv: Starting Netrecv Test Server(Netrecv.pl)\n";
print "Netrecv: ========================================\n";
my $connection = initserversocket($port); # Connectin
+g client socket
#
# Setup the Tk Widgets test screen(text box)
#
my $mw = MainWindow->new;
my $text = $mw->Text(-font => ['Ariel', 12, 'bold'])->pack;
$mw->fileevent($connection, 'readable', [\&read_sock, $connection, $te
+xt]);
MainLoop;
#
# Open a listening socket and wait for a connection
#
sub initserversocket {
my ($port) = @_;
my $sock = IO::Socket::INET->new(
Listen => 5,
Reuse => 1,
Timeout => 200, # Seconds
LocalPort => $port,
Proto => 'tcp');
die "Cannot connect" unless defined $sock;
my $connection = $sock->accept(); # Wait on c
+lient connection
print "Netrecv: Connected to port $port\n\n";
return $connection;
}
#
# Read a callsign from Netxmit.pl and insert into the Text widget
# triggered by Tk fileevent. Send an ACK back to the client.
#
sub read_sock {
my ($sock, $text) = @_;
my $line = <$sock>;
$text->insert('end',"$line\n");
print "Netrecv: $line\n";
$sock->send("ACK\n");
}
#! /usr/bin/perl
# Name: Netxmit.pl - TCP Client for Tk Socket Interface Tes
+ting
# Author: James M. Lynes, Jr. - KE4MIQ
# Created: March 4,2023
# Last Modified: March 4,2023
# Change Log: 03/04/2023 - Created from Qtest.pl(Quisk Test
+Interface)
#
#
# Description: Write a callsign to the Netrecv.pl Server
# over the localhost:4532 socket.
#
# Start Netrecv.pl before Netxmit.pl
#
use strict;
use warnings;
use IO::Socket::INET;
use Time::HiRes;
# Defines
my $host = '127.0.0.1'; # localhost
my $port = '4532'; # Hamlib Po
+rt
my $callsign = 'KE4MIQ'; # Test Call
+sign
my $cmd = "$callsign\n"; # Command s
+tring
print "\nNetxmit: Starting Netxmit Test Client(Netxmit.pl)\n";
print "Netxmit: ========================================\n";
my $sock = initclientsocket($host, $port);
# Write a callsign to the connected server socket
$sock->send($cmd);
print "Netxmit: send: $cmd";
# Read server socket response
my $response = <$sock>;
print "Netxmit recv: $response\n";
sleep 100;
#
# Create a connecting type socket(Netrecv.pl is a listening type sock
+et)
#
sub initclientsocket {
my($host, $port) = @_;
my $sock = IO::Socket::INET->new(
PeerHost => $host,
PeerPort => $port,
Proto => 'tcp');
die "Cannot connect to server $!\n" unless $sock;
print "Netxmit: Connected on port $port\n\n";
return $sock;
}
