Hello,
I'm trying to make a program for RS232 serial communication that uses Tk module.
Since I use Windows 10 the first thing I had to do was converting the module Win32::SerialPort from 32 to 64-bit. Modifying 4 or 5 lines itself took 10 minutes only, finding what to do if Win 10 doesn´t work with RS232 and how to convert it took several weeks). :)
The communication with another laptop Windows 10 with Termite (or CuteCom on Raspberry Pi) functions in both directions: I can send and receive data from both sides.
Things started to become more complicated when I tried to send the received data within the Tk window.
Finally I´ve found that threads could be the solution to my problem - so I´m asking here for Perlmonks wisdom (sincerely I don't know much about threads).
In the version where there was no Tk the program the threads actually functioned: I could send and receive data - they were successfully received from Termite on the other Windows 10 laptop (or CuteCom on raspberry Pi).
In the Tk version of my program Tk window starts but the received data don't show (the way it's written for the time being no wonder it doesn't work).
This is my main module which calls other modules.
#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;
use Win32::SerialPort;
use Getopt::Long;
use threads;
use Thread::Queue;
use Tk;
use Tk::Pane;
use FindCOM;
use SetThreads;
use TkWindow;
use Xport;
use tst;
# program name and version
our $ImePrograma;
our $Verzija;
$ImePrograma="RS232";
$Verzija="1.1215";
&FindCOM;
&SetThreads;
The module FindCOM detects the COM port and sets parameters to 19200,None,8,1. It uses the DOS command mode.
#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;
my @tmp;
my $tmp;
our $PORT;
our $BAUD;
our $PARITY;
our $DATA;
our $STOP;
our $ERR;
our $ERR1;
our $ERR2;
our $ob;
sub FindCOM{
# modern laptops don't have a RS232 port so a RS232 adapter must b
+e used
# DOS command "mode" finds the number of COM when the RS232 is con
+nected
open(LISTDIR,"mode |") || die;
@tmp=<LISTDIR>;
close(LISTDIR);
# detecting the COM port
if($tmp[1]=~/COM/){
# variables $ERR, $ERR1 and $ERR2 are temporary
$ERR="n";
$ERR1="Type a string in the edit line (below) and press <Enter
+>.";
$ERR2="(or wait for the remote device to send data).";
$PORT=$tmp[1];
chomp($PORT);
$PORT=~s/Status for device //i;
$PORT=~s/://;
# setting the COM port
# - variable $PORT
# - 19200: baud rate
# - n: none parity
# - 8: data bits
# - 1: stop bits
open(LISTDIR,"mode $PORT 19200,n,8,1 |") || die;
@tmp=<LISTDIR>;
close(LISTDIR);
$BAUD=$tmp[3];
chomp($BAUD);
$BAUD=~s/ //g;
$BAUD=~s/Baud://i;
$PARITY=$tmp[4];
chomp($PARITY);
$PARITY=~s/ //g;
$PARITY=~s/Parity://i;
$DATA=$tmp[5];
chomp($DATA);
$DATA=~s/ //g;
$DATA=~s/databits://i;
$STOP=$tmp[6];
chomp($STOP);
$STOP=~s/ //g;
$STOP=~s/stopbits://i;
# opening the COM port
# in the version without Tk the opened COM port from here work
+ed
$ob = Win32::SerialPort->new ($PORT) || die "\tSERIAL PORT ERR
+OR: $PORT IS BUSY OR NOT AVAILABLE\n\n";
}
else{
$ERR="y";
$ERR1="Failed to initialize the port.";
$ERR2="Did you forget to connect RS232 adapter to USB?";
}
}
1;
The next module sets threads (at least in the version without Tk):
#!/usr/bin/perl
use strict;
use warnings;
our $log_fh;
our $ob;
our $PORT;
my $thread1;
our $BAUD;
our$PARITY;
our $DATA;
our $STOP;
our $received;
my $thread2;
sub SetThreads{
# in the version without Tk this helped to get rif of annoying on
+screen errors
open($log_fh,"> tmp");
*STDERR = $log_fh;
# THREAD 1: GUI
$thread1 = threads->create(&TkWindow,$received);
$thread1->detach();
# THREAD 2: receiving data from another device
$thread2 = threads->create(&Receive,$PORT,$received);
$thread1->detach();
}
1;
The both threads actually worked in the version without Tk: it received data.
This is the Tk window:
#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;
our $ImePrograma;
our $Verzija;
our $ob;
our $PORT;
our $BAUD;
our $PARITY;
our $DATA;
our $STOP;
my $parameters;
my $thread;
our $received;
our $ERR;
our $ERR1;
our $ERR2;
#our $ERR3;
sub TkWindow{
my $Window_Tk=MainWindow->new;
$Window_Tk->minsize(qw(100 100));
$Window_Tk->title("$ImePrograma $Verzija");
$Window_Tk->configure();
my $notranji_Tk=$Window_Tk->Frame()->pack(-side=>'top',-padx=>10,-
+pady=>10);
# the serial comm. parameters are written at the top of Tk window
my $parameters_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>
+1,-pady=>1);
my $port_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
my $baud_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
my $parity_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0
+);
my $data_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
my $stop_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
if($ERR eq "n"){
my $port_L=$port_Tk->Entry(-relief=>'flat',-text=>"Port = ".$P
+ORT,-justify=>'center',-font=>'Arial 8',-width=>13,-state=>'disabled'
+)->pack();
my $baud_L=$baud_Tk->Entry(-relief=>'flat',-text=>"Baud = ".$B
+AUD,-justify=>'center',-font=>'Arial 8',-width=>14,-state=>'disabled'
+)->pack();
my $parity_L=$parity_Tk->Entry(-relief=>'flat',-text=>"Parity
+= ".$PARITY,-justify=>'center',-font=>'Arial 8',-width=>15,-state=>'d
+isabled')->pack();
my $data_L=$data_Tk->Entry(-relief=>'flat',-text=>"Data = ".$D
+ATA,-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled'
+)->pack();
my $stop_L=$stop_Tk->Entry(-relief=>'flat',-text=>"Stop = ".$S
+TOP,-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled'
+)->pack();
}
else{
my $port_L=$port_Tk->Entry(-relief=>'flat',-text=>"",-justify=
+>'center',-font=>'Arial 8',-width=>13,-state=>'disabled')->pack();
my $baud_L=$baud_Tk->Entry(-relief=>'flat',-text=>"",-justify=
+>'center',-font=>'Arial 8',-width=>14,-state=>'disabled')->pack();
my $parity_L=$parity_Tk->Entry(-relief=>'flat',-text=>"",-just
+ify=>'center',-font=>'Arial 8',-width=>15,-state=>'disabled')->pack()
+;
my $data_L=$data_Tk->Entry(-relief=>'flat',-text=>"",-justify=
+>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
my $stop_L=$stop_Tk->Entry(-relief=>'flat',-text=>"",-justify=
+>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
}
# the part of the Tk window where received data are supposed to be
+ written
my $receive_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>1,-
+pady=>3);
my $pane_receive_Tk = $receive_Tk->Scrolled("Pane",Name => 'Receiv
+e',-scrollbars => 'e',-sticky => 'n',-gridded => 'y',-width=>400,-hei
+ght=>400,-background=>'white');
$pane_receive_Tk->Frame;
$pane_receive_Tk->pack;
# in the begining i wasn't sure if the thread should be defined he
+re or not so i left it commented
#$thread = threads->create(&Receive,$PORT,$BAUD,$PARITY,$DATA,$rec
+eived);
#$thread->detach();
my $pane_receive_L=$pane_receive_Tk->Entry(-relief=>'flat',-text=>
+$ERR1,-font=>'Arial 9',-width=>55,-background=>'white')->pack(-ipadx=
+>2);
$pane_receive_L=$pane_receive_Tk->Entry(-relief=>'flat',-text=>$ER
+R2,-font=>'Arial 9',-width=>55,-background=>'white')->pack(-ipadx=>2)
+;
# this is the part of code which should sent received data to this
+ Tk window
# it prints two lines only - without the received data
# my approach fails so this is the core of my question
my @InboundParameters = @_;
print("In the thread\n");
print('Got parameters >', join('<>',@InboundParameters), "\n");
# entry
my $send_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>0,-pad
+y=>0);
my $sendE_Tk=$send_Tk->Frame()->pack(-side=>'left',-pady=>1,-padx=
+>0);
my $sendG_Tk=$send_Tk->Frame()->pack(-side=>'left',-pady=>1,-padx=
+>3);
my $send_E=$sendE_Tk->Entry(-font=>'Arial 8',-width=>61)->pack();
my $send_G=$sendG_Tk->Button(-text=>'Send',-font=>'Arial 8',-backg
+round=>'grey',-command=>sub{exit;})->pack(-ipadx=>3);
&MainLoop();
}
1;
Array @InboundParameters should somehow send the received data to the Tk window but fails - which is the core of my post: how to do it?
The module that receives data is below; I didn't modify much from the original version found in forums:
#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;
our $received;
our $PORT;
my $x;
our $ob;
my $gotit;
my $found;
my $end;
my $obattern;
my $instead;
my $timeout;
my $thread4;
sub Receive{
$x=1;
# this remains from the not Tk version
print "\n\t"."-"x32 ."\n";
print "\tRECEIVING LINES FROM OTHER PARTY\n";
print "\t"."-"x32 ."\n";
while(1){
$received = ReadPort($PORT, 5);
if($received ne ""){
print "\t$x\tRX>\t$received\n";
$ob->write("Sent back by my script> ".$received."\n");
$x++;
}
}
print "\n";
print "";
sub ReadPort{
# Store timeout time in millisecond tic $timeout = $ob->get
+_tick_count + (1000 * $timeout);
$ob->lookclear; # Clear lookfor buffers
$gotit = "";
while(1) {
# polls until we have a line of data
return unless ( defined ($gotit = $ob->streamline) );
if ($gotit ne "") {
($found, $end, $obattern, $instead) = $ob->lastlook;
return "$gotit";
}
# or an error
return if ($ob->reset_error);
if ($ob->get_tick_count > $timeout) {
my ($match, $after, $obattern, $instead) = $ob->lastlo
+ok;
return ;
}
}
}
}
1;
Thanks for your help in advance!
Marjacktablet