Assaf Hi,
I used the PortMon as you suggested and it helped me to find my problems
(most of them).
The files are attached in the following. I still have a timing problem. I
inserted a short delay loop to the script which makes it possible for the
receiving side to handle the received data properly. Avoiding this delay
will cause loosing some of the transmitted data bytes.
To use the scripts open two 'cmd' windows. Run serverSide.exe in the first
window then clientSide.exe in the second.
My question is if there is an elegant way to avoid the inserted delay to the
script?
The following three files follows.
Thanks,
Moshe Okman
==========================================================================
myUtils.pm
==========
#!/usr/bin/perl -w
use strict;
our @hexValues;
our $ob;
our $SelectedPort;
our $BaudrateVal;
our $ParityVal;
our $DataBitsVal;
our $StopBitsVal;
our $HandshakeVal;
# --[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---
# --[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---
# --[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---[int2hex]---
sub int2hex ()
{
my $rcvedVal = $_[0];
my $fieldSize = $_[1];
my $retVal;
my $tmpVal = "";
my $digit;
if (length ($fieldSize) == 0)
{
$fieldSize=2;
}
$retVal = sprintf("%0*d",$fieldSize,$retVal);
while ($rcvedVal) {
$digit = $rcvedVal & 0xF;
$tmpVal = $hexValues[$digit].$tmpVal;
$rcvedVal >>= 4;
}
$retVal .= $tmpVal;
$retVal = substr($retVal,(length($retVal)-$fieldSize));
return $retVal;
} # End of "int2hex".
# --[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---
# --[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---
# --[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---[hex2int]---
sub hex2int ()
{
my $rcvedVal = $_[0];
my $retVal = 0;
my $digit;
my $k;
my $j;
my @rv;
$rcvedVal =~ s/0x//;
@rv = split (//,$rcvedVal);
for ($j=0;$j<@rv;$j++) {
$digit = uc($rv[$j]);
for ($k=0; $k<16; $k++) {
if ($hexValues[$k] eq $digit)
{
$retVal *= 16;
$retVal += $k;
last;
}
}
}
return $retVal;
} # End of "hex2int".
# --[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---
# --[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---
# --[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---[trim]---
# Perl trim function to remove whitespace from the start and end of the
string
sub trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
# --[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---
# --[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---
# --[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---[ltrim]---
# Left trim function to remove leading whitespace
sub ltrim($)
{
my $string = shift;
$string =~ s/^\s+//;
return $string;
}
# --[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---
# --[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---
# --[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---[rtrim]---
# Right trim function to remove trailing whitespace
sub rtrim($)
{
my $string = shift;
$string =~ s/\s+$//;
return $string;
}
# --[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---
# --[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---
# --[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---[Pause]---
sub Pause()
{
my $InValue;
print "\n\n\n\nType CONTROL-C to quit.\r\n\n";
print "Hit any other key to continue.\r\n\n\n\n";
$InValue = <STDIN>;
} # End of "Pause".
#
--[InitSerialPort]---[InitSerialPort]---[InitSerialPort]---[InitSerialPort]-
--
#
--[InitSerialPort]---[InitSerialPort]---[InitSerialPort]---[InitSerialPort]-
--
#
--[InitSerialPort]---[InitSerialPort]---[InitSerialPort]---[InitSerialPort]-
--
sub InitSerialPort()
{
$ob = Win32::SerialPort->new ($SelectedPort) || die "Can't open
$SelectedPort: $!";
$ob->baudrate($BaudrateVal) || die "fail setting baudrate";
$ob->parity($ParityVal) || die "fail setting parity";
$ob->databits($DataBitsVal) || die "fail setting databits";
$ob->stopbits($StopBitsVal) || die "fail setting stopbits";
$ob->handshake($HandshakeVal) || die "fail setting handshake";
$ob->buffers(4096,4096);
$ob->write_settings || die "no settings";
$ob->error_msg(1); # use built-in error messages
$ob->user_msg(1);
$ob->datatype('raw');
$ob->status();
$ob->read_char_time(0); # avg time between read char
} # End of "SerialInit".
#
--[StopSerialPort]---[StopSerialPort]---[StopSerialPort]---[StopSerialPort]-
--
#
--[StopSerialPort]---[StopSerialPort]---[StopSerialPort]---[StopSerialPort]-
--
#
--[StopSerialPort]---[StopSerialPort]---[StopSerialPort]---[StopSerialPort]-
--
sub StopSerialPort()
{
undef $ob;
} # End of SerialStop.
1;
==========================================================================
serverSide.pl
=============
#!/usr/bin/perl
eval {use Cwd;};
use strict;
use warnings;
use IO::Handle;
# Serial Support.
use Win32::SerialPort;
our @hexValues =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
our $inBuffer;
our $lastEvent;
our $SelectedPort = "COM1";
our $BaudrateVal = 115200;
our $ParityVal = "none";
our $DataBitsVal = 8;
our $StopBitsVal = 1;
our $HandshakeVal = "none";
our $ob = 0;
our $RunFlag;
use myUtils;
sub AddCRCSignature() {
printf "Adding CRC \n";
} # End of "AddCRCSignature".
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
#my @timeData;
use Time::Local;
printf "Serial Port settings:\n";
printf
"$SelectedPort,$BaudrateVal,(Parity)$ParityVal,$DataBitsVal(bits),$StopBitsV
al(StopBits),(HandShake)$HandshakeVal\n";
&InitSerialPort();
$RunFlag = 1;
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# In server mode the program will return any sequence of bytes it receieves
from
# the other side.
# The client side will send a chunk of numbers to the peer and expect to get
them back.
my $prompt;
our @txDataBuffer;
our @rxDataBuffer;
my $k;
my $j;
my $doneFlag = 0;
my $byteValue;
$lastEvent = time();
printf "\n\nXXXX Server Simulator.\n";
printf "========================== \n";
$inBuffer = "";
$prompt = "SER> ";
$doneFlag = 0;
while ($RunFlag) {
while (!$doneFlag) {
my $tmpVal;
# Collect the data of the received message.
if (($inBuffer = $ob->input) ne "")
{ # Something was received on the serial link.
$tmpVal = unpack('C*',$inBuffer);
$tmpVal = &int2hex($tmpVal);
printf "$tmpVal ";
$lastEvent = time();
push(@rxDataBuffer,$tmpVal);
} # Something was received on the serial link.
if (@rxDataBuffer && ((time()-$lastEvent)>3)) {
# 3 sec. past the last received char.
$doneFlag = 1;
}
} # Collect the data of the received message.
if ($doneFlag) {
printf "\n$prompt";
while (@rxDataBuffer) {
$k = shift (@rxDataBuffer);
$k = &hex2int ($k);
$byteValue = pack("C*",$k);
$ob->write($byteValue);
for ($j=0;$j<400000;$j++) {}; # Short delay.
} # End of while $rxDataBuffer is not empty ...
$inBuffer = "";
$doneFlag = 0;
}
} # End while ...
&StopSerialPort();
1;
==========================================================================
clientSide.pl
=============
#!/usr/bin/perl
eval {use Cwd;};
use strict;
use warnings;
use Win32::SerialPort;
our @hexValues =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
our $inBuffer;
our $lastEvent;
our $SelectedPort = "COM2";
our $BaudrateVal = 115200;
our $ParityVal = "none";
our $DataBitsVal = 8;
our $StopBitsVal = 1;
our $HandshakeVal = "none";
our $ob = 0;
use myUtils;
our $RunFlag;
sub AddCRCSignature() {
printf "Adding CRC \n";
} # End of "AddCRCSignature".
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
#
--[Initialization]---[Initialization]---[Initialization]---[Initialization]-
--
my @timeData;
use Time::Local;
printf "Serial Port settings:\n";
printf
"$SelectedPort,$BaudrateVal,(Parity)$ParityVal,$DataBitsVal(bits),$StopBitsV
al(StopBits),(HandShake)$HandshakeVal\n";
&InitSerialPort();
$RunFlag = 1;
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# --[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---[Main]---
# In server mode the program will return any sequence of bytes it receieves
from
# the other side.
# The client side will send a chunk of numbers to the peer and expect to get
them back.
my $prompt;
our @txDataBuffer;
our @rxDataBuffer;
my $k;
my $j;
my $doneFlag = 0;
my $byteValue;
$lastEvent = time();
printf "\n\nXXXX client Simulator.\n";
printf "======================\n";
$inBuffer = "";
$prompt = "KB> ";
my $txDB = "1 2 12 0x1a 0x2b 0x32 0x75 0x87 0xa3 0xb5 0xf3 00";
@txDataBuffer = split (/ /, $txDB );
printf "SER> \n"; # Stands for SERIAL stream.
&AddCRCSignature(); # Currently is an empty shell.
while (@txDataBuffer) {
# The @txDataBuffer is not empty.
$k = shift (@txDataBuffer); # Should be an Unsigned BYTE
value {0..255}
printf "$k ";
if ($k =~ m/^0x/) {$k = &hex2int($k)};
$byteValue = pack("C*",int($k));
for ($j=0;$j<400000;$j++) {}; # Short delay.
$ob->write($byteValue);
} # The @txDataBuffer is not empty.
printf "\n";
while (!$doneFlag) {
my $tmpVal;
# Collect the data of the received message.
if (($inBuffer = $ob->input) ne "")
{ # Something was received on the serial link.
$tmpVal = unpack('C*',$inBuffer);
$tmpVal = &int2hex($tmpVal);
printf "$tmpVal ";
$lastEvent = time();
push(@rxDataBuffer,$tmpVal);
} # Something was received on the serial link.
if (@rxDataBuffer && ((time()-$lastEvent)>3)) {
# 3 sec. past the last received char.
$doneFlag = 1;
}
} # Collect the data of the received message.
printf "\nDone.\n";
&StopSerialPort();
1;
----------------------------------------------------------------------------
-----Original Message-----
From: Assaf Gordon [mailto:gor...@cshl.edu]
Sent: Wednesday, July 07, 2010 12:11 AM
To: Moshe Okman
Cc: Perl in Israel
Subject: Re: [Israel.pm] Using a serial port (rs-232) from perl.
Moshe,
Moshe Okman wrote, On 07/05/2010 09:23 AM:
> I have a problem with using a serial port and I hope that someone
> will be able to help me here.
"PortMon" is your friend (
http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx ).
Don't try any serial communication on Windows without it.
It will help you pin-point the problem, whether data gets
transmitted/received correctly (and then it's a perl problem) or if the data
simply didn't arrive.
Don't forget to switch to "hex" mode, and always save to log to disk.
> I face two main problems:
>
> 1) When the value I try to transmit is 0x00 the script will get
> stuck. Assuming that $ch = 0; $ob->write($ch); ====> This will
> cause the script to freeze.
>
> From my point of view the 0x00 value is a valid data byte and I must
> be able to pass it through.
It should work, but verify what happens with Portmon (i.e. on the sending
machine, you'll see if the NT-kernel function even got this write call or
not).
Make sure you're not using any kind of flow control: $ob->handshake("none");
>
> 2) When I send successively several values, the peer side will get a
> problem to distinguish between these values.
>
> Consider the following lines:
> @txArray = (0x83, 0x95, 0x17, 0x2A, 0xB2);
> foreach $k (@txArray) {
> $ob->write($k);
>
> }
>
> The required values are sent to the peer side and are temporarily
> stored into a system buffer that serves the $ob.
>
> When my script there does:
>
> If ($inBuffer = $ob->input) {
>
> printf $inBuffer; ===> This will show that $inBuffer
> == "1311492342."
>
> }
Very strange.
could it be that you're actually sending the string representation of those
numbers ( e.g. three characters '1', '3', '1', etc. ) ?
Again, portmon will show you that immediately.
To force sending bytes, use pack:
my $raw_byte_data = pack("C*", 131, 149, 23, ... ) ;
$ob->write($raw_byte_data);
Once again, portmon in hex mode (on the sending machine) will tell you how
the OS sees your data.
Portmon on the receiving machine will tell you how the OS got your raw data
(before Perl grabs it).
>
> Inserting a delay in the transmitting side helps to solve this
> problem since it lets the peer enough time to handle each
> transmitted byte
>
Timing can be tricky in windows. Generally, it's best to avoid tinkering
with it.
If (after debugging with Portmon) you're still losing information, try
changing the read timeouts, some information available here:
http://www.ewoodruff.us/CUJArticle/CUJArticle.html
http://www.codeproject.com/KB/system/chaiyasit_t.aspx
Also,
try to have one end a non-perl program (e.g. the sample from CodeProject
above) to check if it's a perl issue or a transmission issue.
If you look at the "Timeouts" section in the CPAN POD:
http://search.cpan.org/~bbirth/Win32-SerialPort-0.22/lib/Win32/SerialPort.pm
It mentions the possibility of setting "read_interval" to 0xFFFFFFFF and
then go into non-blocking mode. Might be worth a try.
-gordon
_______________________________________________
Perl mailing list
Perl@perl.org.il
http://mail.perl.org.il/mailman/listinfo/perl
