[Perl-unix-users] Help: read/sysread problems

[Mundell, R. \(Ronald\)]

Title: Help: read/sysread problems

Good Day All

I am experiencing some difficulties with the read/sysread functions. When I transmit data it works fine. When I received data thru the serial port, it only returns the first 8 characters. I have put a serial port sniffer and the device returns all the correct data. Thus the problem lies with the read/sysread function. I have included an extract of the code to assist you to identify the problem. If anyone of you have experienced this problem before, please could you direct me in the direction to resolve this issue.

What I have identified so far is that it only returns the first 8 bytes. I always send out 7 bytes. If I receive less than or equal to 8 bytes, it works correctly. The problem is only when I tries to receive more than 8. The one command I issue must return around 30 bytes, but I only receives 8 bytes.

I hope someone out there can help me to solve this problem

Thank you

#!/usr/bin/perl -w

use strict;
use POSIX qw(setsid);
use Time::HiRes 'usleep';
require "Comms.pm";

my $CMD_ACK                     = '0';
my $CMD_TIME                    = '1';
my $CMD_SYNC                    = '2';
my $CMD_GBAY                    = '3';
my $CMD_SBAY                    = '4';
my $CMD_PACKET_NO       = '5';
my $CMD_SEND_1                  = '6';
my $CMD_STATUS                  = '7';
my $CMD_CLRPACKETS      = '8';

#define StartBit                0   // :
#define Rx_Address_Hi  1   // To whom it was send
#define Rx_Address_Lo  2
#define Tx_Address_Hi   3   // From whom it was send
#define Tx_Address_Lo  4
#define Command                 5   // What to do
#define Packet_Length   6   // Length Off data to follow
#define TX_Data                 7   // onwards
#define CRC_BYTE

QueryController(qq|000001|);

sub QueryController($)
{
    my $controllerNo    = shift @_;
    my $port            = qq|/dev/ttyS0|;
    my $HostAddress     = qq|000902|;
    my $ContLo          = chr (  $controllerNo & 0xFF );
    my $ContHi          = chr (( $controllerNo >> 8 ) & 0xFF);
    my $HostLo          = chr (  $HostAddress & 0xFF );
    my $HostHi          = chr (( $HostAddress >> 8 ) & 0xFF);
    my $query;
    my $response;
    my $len;
    my $status = 0;

    &OpenPort ( $port );

    $| = 1;
    $query = qq|:$ContHi$ContLo$HostHi$HostLo$CMD_ACK\r|;
    my $res = &WriteData($query);
    if ( $res != 0 )
    {
        print "FAIL writing To Port\n";
        return;
    }

    $response = &ReadData(20);
    print sprintf "RESPONSE: %s\n", Bin2Hex ( $response, length( $response ));
    if ( $response =~ /^:$HostHi$HostLo$ContHi$ContLo/ )
    {
        my $cmd = substr ($response, 5, 1);
        if ( $cmd == $CMD_ACK )
        {
            sleep 1;
            $| = 1;
            $query = qq|:$ContHi$ContLo$HostHi$HostLo$CMD_TIME\r|;
            &WriteData($query);
            $response = ReadData (0xFF);
            print sprintf "RESPONSE: %s\n", &Bin2Hex ( $response, length( $response ));
            if ( $response =~ /:$HostHi$HostLo$ContHi$ContLo/ )
            {
                my $cmd = substr ($response, 5, 1);
                if ( $cmd == $CMD_TIME )
                {
                    print sprintf "RESPONSE: %s\n", &Bin2Hex ( $response, length( $response ));
                    &ClosePort();
                    return $status & 0xFF;
                }
            }
            else
            {
                print sprintf "WRONG RESPONSE: %s\n", &Bin2Hex ( $response, length( $response ));
            }
        }
        else
        {
            print sprintf "WRONG RESPONSE: %s\n", &Bin2Hex ( $response, length( $response ));
        }
    }
    else
    {
        print sprintf "WRONG RESPONSE: %s\n", &Bin2Hex ( $response, length( $response ));
    }
    &ClosePort();
    return $status & 0xFF;
}

#################################Comms.pm#######################################
#!/usr/bin/perl -w
use strict;
use IO::Handle;
use POSIX qw(:termios_h);

sub OpenPort ($);
sub ReadData ($);
sub WriteData($);
sub ClosePort();

my $termios;
my $c_cflag;
my $c_iflag;
my $c_oflag;
my $c_lflag;

sub OpenPort ($)
{
    my $portname = shift( @_ );
    chomp $portname;
   
    sysopen ( IOPORT, $portname, &POSIX::O_RDWR ) or die ( "Unable to open Port: $portname $!" );
   
    $termios = POSIX::Termios->new;

    $c_cflag = &POSIX::CS8 | &POSIX::CLOCAL | &POSIX::CREAD;
    $c_iflag = &POSIX::IGNPAR | &POSIX::IGNCR | &POSIX::IGNBRK;
    $c_oflag = 0;
    $c_lflag = 0;
 
    $termios->setispeed( &POSIX::B38400 );
    $termios->setospeed( &POSIX::B38400 );
    $termios->setoflag ( $c_oflag );
    $termios->setlflag ( $c_lflag );
    $termios->setiflag ( $c_iflag );
    $termios->setcflag ( $c_cflag );
    $termios->setcc ( &POSIX::VTIME, 0 );
    $termios->setcc ( &POSIX::VMIN,  1 );
    $termios->setattr ( fileno(IOPORT), &POSIX::TCSANOW );
}

sub ClosePort()
{
    close IOPORT;
    undef $termios;
}

sub WriteData($)
{
    my $Data = "" @_;
    my $len = syswrite ( IOPORT, $Data, length ( $Data ));
    if ( $len <= 0)
    {
        return -1;
    }
    return 0;
}

sub ReadData($)
{
    my $readlen = shift @_;
    my $buffer;
    my $len = sysread ( IOPORT, $buffer, $readlen );
    if ( $len <= 0)
    {
        return -1;
    }
    return $buffer;
}

1;

---

This email and any accompanying attachments may contain confidential and proprietary information.  This information is private and protected by law and, accordingly, if you are not the intended recipient, you are requested to delete this entire communication immediately and are notified that any disclosure, copying or distribution of or taking any action based on this information is prohibited.

Emails cannot be guaranteed to be secure or free of errors or viruses.  The sender does not accept any liability or responsibility for any interception, corruption, destruction, loss, late arrival or incompleteness of or tampering or interference with any of the information contained in this email or for its incorrect delivery or non-delivery for whatsoever reason or for its effect on any electronic device of the recipient.

If verification of this email or any attachment is required, please request a hard-copy version.

---