Hi Moshe,
I suspect your timing issues are merely a mis-use of the "unpack" function
(this is just a guess, but worth testing).
Here's what happens (if I followed you code correctly, since I don't have a
windows machine to test it):
On the server side:
you have a list of values to send,
you convert it to bytes (with pack),
and send it to the client.
On the client side:
you get the data with "$on->input()",
then use "unpack" to convert the bytes to 'values'.
But here's the catch:
$tmpVal = unpack('C*',$inBuffer);
unpack() is supposed to return a *list* of values (that's the way the function
works, and that's why the asterisk is there).
But you are calling it in a scalar variable.
Per documentation, "unpack" will return the *first* value only if called in a
scalar context (Perl gurus - if I'm wrong here, feel free to interject).
So in practice - you'll always get only the first byte out of a chunk of data.
That's why, if you send it slowly enough, each byte will be received on the
client side as a single chunk (i.e. "$ob->input" will return just one byte
instead of a buffer).
Again, this assumes Portmon on both sides showed you that the data is indeed
arriving correctly, and it's just perl that's acting up.
Change the variable into a list and then check what you've received.
BTW,
I'm a bit concerned about your int2hex,hex2int functions.
If I understand them correctly, you intended to code numeric values in specific
field lengths or bytes sizes, most likely to adhere to some binary protocol
with your serial device.
However, I'm not sure they are working correctly (e.g. when testing int2hex I
got "use of uninitialized value $retVal").
A better way to encode binary values is to use the "pack" function.
read the pack tutorial:
http://perldoc.perl.org/functions/pack.html
http://perldoc.perl.org/perlpacktut.html
Example:
If your data structure is:
1 BYTE = Header = 'A'
4 BYTES (little-endian) = size = 4
2 BYTES (little-endian) = message
4 BYTES (little-endian) = param1
4 BYTES (little-endian) = param2
1 BYTE = CRC
1 BYTE = Trailer = 'Z'
You could use the following code to encode them correctly:
# just made-up values
my $message = 42 ;
my $size = 12 ;
my $param1 = 0 ;
my $param2 = 1 ;
my $crc = crc ( $message, $size, $param1, $param2 ) ;
# Encode the values
my @data = ( 'A', $size, $message, $param1, $param2, $crc, 'Z' );
my $buffer = pack( "C V v V V C C", @data ) ;
And then $buffer will be encoded with all the endian-ness and zero-padding
necessary.
For the decoding part, "unpack" will do the reverse (or Data::ParseBinary
published by a member of this list).
Regards,
-Assaf
Moshe Okman wrote, On 07/12/2010 11:01 AM:
> 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:[email protected]]
> 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
[email protected]
http://mail.perl.org.il/mailman/listinfo/perl
