Sockets, Modbus Implementation, fd_select()

The following example shows how Modbus I/O is done via a TCP/IP socket interface.

#!/usr/bin/env perl 
use strict; 
use Socket;
use Fcntl; 
  
my ($remote, $port) = qw( hasa106bc01 502); 
my $iaddr = inet_aton( $remote) or die "no host $remote"; 
my $paddr = sockaddr_in( $port, $iaddr); 
my $proto = getprotobyname( 'tcp'); 
socket( SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!"; 
connect( SOCK, $paddr) or die "connect: $!";
my $flags = fcntl( SOCK, F_GETFL(), 0);
$flags  &= ~O_NONBLOCK();    
fcntl( SOCK, F_SETFL(), $flags);
#
# create PDU, protocol data unit
#
my $fc = 0x17;           # read/write multiple registers
my $countR = 12;         # read count, in units of 2B
my $adrR = 0x4000;       # start address for read
my $adrW = 0x4003;       # start address for write
my @values = qw( 14 17); # write values
my $countW = scalar( @values); 
my $bc = $countW*2;      # write count in B
my $pdu = pack "CnnnnCn*", $fc, $adrR, $countR, $adrW, $countW, $bc, @values;  
#
# create TCP header, 7B
#
my $tid = 1234;                # Transaction identifier, 2B, recopied by the server
my $pid = 0;                   # Protocol identifier, 2B, 0 = MB
my $len = (length( $pdu) + 1); # Len, 2B, number of following bytes, including uid and data
my $uid = 1;                   # Unit identifier, 1B, identification of a remote slave
my $header = pack "nnnC", $tid, $pid, $len, $uid;
#
# append PDU to header
#
my $msg = $header . $pdu; 

syswrite( SOCK, $msg, length( $msg), 0); 

goto finish if( !fd_select( \*SOCK, 1.0));

my $response; 
my $exp = 7 + 2 + 2*$countR; 
my $len = sysread( SOCK, $response, $exp, 0); 
print " received $len/$exp \n"; 

$header = substr($response, 0, 6); 
my ($tid, $prid, $len) = unpack 'nnn', $header;
#my ($tid, $prid, $hilen, $lolen) = unpack 'nnCC', $header;

#print " tid $tid, prid $prid, hilen $hilen, lolen $lolen \n"; 

my ($unit, $fc, $bc) = unpack 'C*', substr($response, 6, 3);
print sprintf " unit $unit, f 0x%x, bc $bc \n", $fc; 

my @data = unpack 'n*', substr($response, 9);
print " data @data \n"; 

#my $len = 0x100 * $hilen + $lolen;
print " len $len \n"; 

finish:
close( SOCK); 
exit;
#
# select
#
sub fd_select
{
    my ( $fd, $tmo) = @_; 
    my $rin = my $win = my $ein = ""; 
    vec( $rin, fileno( $fd), 1) = 1; 
    $ein = $rin | $win; 
    my ( $nfd, $remaining) = select( $rin, $win, $ein, $tmo); 
    wantarray ? ( $nfd, $remaining) : $nfd;
}