#!/usr/bin/perl -w
# Perl Modbus Client

use Socket;
use Getopt::Std;

use vars qw($opt_u $opt_r $opt_c $opt_g $opt_t $opt_h $opt_s $opt_p);

my ($remote, $port, $iaddr, $paddr, $proto, $line, $ans);
my ($ta_id, $prot_id, $unit_id, $mb_fc, $ref, $count, @data);

# Der Client wird flexibel durch Optionen, die es erlauben,
# ihn wie ein klassisches Unix-Tool mit vielen Parametern
# aufzurufen
$unit_id = $opt_u = 1;         # SPS-Station
$ref =     $opt_r = 0;         # Register darauf
$count =   $opt_c = 16;        # Anzahl übertragener Register
          $opt_g = 0;         # Anforderung zum Lesen
          $opt_t = 0;         # Anforderung zum Schreiben
          $opt_h = 0;         # Anforderung der Hilfe
$remote =  $opt_s = 'server';  # IP-Name des Servers
$port =    $opt_p = 502;       # Port-Nummer

getopts('u:r:c:gths:p:'); # Abfrage der Parameter

if ($opt_h)  {
# Netterweise eine Gebrauchsanweisung
 print "\n usage: $0 [-u unit(1)] [-r register(0)] [-c count(16)]\n",
         "         [(-g et)|-t ransmit] [-h elp]\n",
         "         [-s server(yak)] [-p port(502)]\n\n";
 exit;
}

# Welche Optionen sind eingegeben worden?
$unit_id = $opt_u;
$ref =     $opt_r;
$count =   $opt_c;
$remote =  $opt_s;
$port =    $opt_p;

$mb_fc = 3;
if ($opt_t) {
 unless ($opt_g) {
#   wenn nicht lesen, dann schreiben
   $mb_fc = 16;
   @data = @ARGV;
   $count = $#data + 1;
 }
}

$ta_id = 1234;   # beliebig
$prot_id = 502;  #    " - aber in Anlehung an die Portnummer

# Verbindungsdaten festlegen
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No Port" unless $port;
$iaddr = inet_aton($remote) or die "No Host: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');

while ( 1 ) {
# dieser Client hält eine dauernde Verbindung zum Server
# dies erlaubt die kontinuierliche Beobachtung der Simulation
 socket(SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
 connect(SOCK, $paddr) or die "connect: $!";

# Netzwerkverbindung und Terminalausgabe ungepuffert.
 select SOCK;
 $| = 1;
 select STDOUT;
 $| = 1;

# Request formulieren (binär!)
 $line = pack "nnnCCnn", $ta_id, $prot_id, 6, $unit_id, $mb_fc, $ref, $count;

 if ( $mb_fc == 0x10 ) {
#   binär kodieren - Big Endian
   $line .= pack 'Cn*', 2*$count, @data;
 }

# und absenden
 send SOCK, $line, 0;

# ein wenig Geduld zeigen - hier 100 msec
 select(undef, undef, undef, 0.1);
# und auf Antwort warten
 next unless defined(recv SOCK, $ans, 6+3+2*$count, 0);
# Wenn der Server die Verbindung nicht schließt, dann tun wir das
 close (SOCK);
# und bereiten die Ausgabe vor
 my $header = substr($ans, 0, 6);
 my ($tid, $prid, $hilen, $lolen) = unpack 'nnCC', $header;
 my ($unit, $fc, $bc) = unpack 'C*', substr($ans, 6, 3);
# binär dekodieren
 @data = unpack 'n*', substr($ans, 9);
 my $len = 0x100 * $hilen + $lolen;
 print "Unit $unit(Ref $ref): ";
 foreach (@data) {
   printf "%5d ", $_;
 }
 print "\n";
 if ( $mb_fc == 0x10 ) {
#   wenn wir nur geschrieben haben, Schluß
   exit;
 }
}
exit;
# That's it