#!/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