# Perl module: Client ModBus / TCP class 1
#     Version: 1.50
#     Website: https://github.com/sourceperl/MBclient/
#        Date: 2014-07-03
#     License: MIT (http://http://opensource.org/licenses/mit-license.php)
# Description: Client ModBus / TCP command line
#              Support functions 3 and 16 (class 0)
#              1,2,4,5,6 (Class 1)
#     Charset: us-ascii, unix end of line

# todo
#   - add support for MEI function
# 

package MBclient;

## Required Modules

use 5.005;
use strict;
use vars qw($AUTOLOAD $VERSION @ISA @EXPORT);
use Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw(MODBUS_TCP MODBUS_RTU
             EXP_ILLEGAL_FUNCTION EXP_DATA_ADDRESS EXP_DATA_VALUE
             EXP_SLAVE_DEVICE_FAILURE  EXP_ACKNOWLEDGE EXP_SLAVE_DEVICE_BUSY
             EXP_MEMORY_PARITY_ERROR EXP_GATEWAY_PATH_UNAVAILABLE 
             EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND
             MB_NO_ERR MB_RESOLVE_ERR MB_CONNECT_ERR MB_SEND_ERR
             MB_RECV_ERR MB_TIMEOUT_ERR MB_FRAME_ERR MB_EXCEPT_ERR);
use Socket;
use bytes;

our $VERSION = '1.50';

##
## Constant
##

## ModBus/TCP
use constant MODBUS_PORT                                 => 502;
## ModBus RTU
use constant FRAME_RTU_MAXSIZE                           => 512;
## Modbus mode
use constant MODBUS_TCP                                  => 1;
use constant MODBUS_RTU                                  => 2;
## Modbus function code
# standard
use constant READ_COILS                                  => 0x01;
use constant READ_DISCRETE_INPUTS                        => 0x02;
use constant READ_HOLDING_REGISTERS                      => 0x03;
use constant READ_INPUT_REGISTERS                        => 0x04;
use constant WRITE_SINGLE_COIL                           => 0x05;
use constant WRITE_SINGLE_REGISTER                       => 0x06;
use constant WRITE_MULTIPLE_REGISTERS                    => 0x10;
use constant MODBUS_ENCAPSULATED_INTERFACE               => 0x2B;
## Modbus except code
use constant EXP_ILLEGAL_FUNCTION                        => 0x01;
use constant EXP_DATA_ADDRESS                            => 0x02;
use constant EXP_DATA_VALUE                              => 0x03;
use constant EXP_SLAVE_DEVICE_FAILURE                    => 0x04;
use constant EXP_ACKNOWLEDGE                             => 0x05;
use constant EXP_SLAVE_DEVICE_BUSY                       => 0x06;
use constant EXP_MEMORY_PARITY_ERROR                     => 0x08;
use constant EXP_GATEWAY_PATH_UNAVAILABLE                => 0x0A;
use constant EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND => 0x0B;
## Module error codes
use constant MB_NO_ERR                                   => 0;
use constant MB_RESOLVE_ERR                              => 1;
use constant MB_CONNECT_ERR                              => 2;
use constant MB_SEND_ERR                                 => 3;
use constant MB_RECV_ERR                                 => 4;
use constant MB_TIMEOUT_ERR                              => 5;
use constant MB_FRAME_ERR                                => 6;
use constant MB_EXCEPT_ERR                               => 7;


##
## Constructor.
##

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  ##
  ## UPPERCASE items have documented accessor functions.
  ## lowercase items are reserved for internal use.
  ##
  $self->{VERSION}       = $VERSION;          # version number
  $self->{HOST}          = undef;             # 
  $self->{PORT}          = MODBUS_PORT;       # 
  $self->{UNIT_ID}       = 1;                 # 
  $self->{LAST_ERROR}    = MB_NO_ERR;         # last error code   
  $self->{LAST_EXCEPT}   = 0;                 # last expect code   
  $self->{MODE}          = MODBUS_TCP;        # by default modbus/tcp
  $self->{sock}          = undef;             # socket handle
  $self->{timeout}       = 30;                # socket timeout
  $self->{hd_tr_id}      = 0;                 # store transaction ID
  $self->{debug}         = 0;                 # enable debug trace
  # object bless
  bless $self, $class;
  return $self;
}

##
## Get current version number.
##

sub version {
  my $self = shift;
  return $self->{VERSION};
}

##
## Get last error code.
##

sub last_error {
  my $self = shift;
  return $self->{LAST_ERROR};
}

##
## Get last except code.
##

sub last_except {
  my $self = shift;
  return $self->{LAST_EXCEPT};
}

##
## Get or set host field (IPv4 or hostname like "plc.domain.net").
##

sub host {
  my $self = shift;
  my $hostname  = shift;
  # return last hostname if no arg
  return $self->{HOST} unless defined $hostname;
  # if host is IPv4 address or valid URL
  if (($hostname =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) or 
      ($hostname =~ m/^[a-z][a-z0-9\.\-]+$/)) {
    $self->{HOST} = $hostname;
  }
  return $self->{HOST};
}

##
## Get or set TCP port field.
##

sub port {
  my $self = shift;
  my $port  = shift;
  # return last hostname if no arg
  return $self->{PORT} unless defined $port;
  # if host is IPv4 address or valid URL
  if (($port =~ m/^\d{1,5}$/) and 
      ($port < 65536)) {
    $self->{PORT} = $port;
  }
  return $self->{PORT};
}

##
## Get or set unit_id field.
##

sub unit_id {
  my $self = shift;
  my $uid  = shift;
  # return unit_id if no arg
  return $self->{UNIT_ID} unless defined $uid;
  # if uid is numeric, set unit_id
  if ($uid =~ m/^\d{1,3}$/) {
   $self->{UNIT_ID} = $uid;
  }
  return $self->{UNIT_ID};
}

##
## Get or set modbus mode (TCP or RTU).
##

sub mode {
  my $self = shift;
  my $mode  = shift;
  # return mode if no arg
  return $self->{MODE} unless defined $mode;
  # set mode and return mode
  $self->{MODE} = $mode;
  return $self->{MODE};
}

##
## Open TCP link.
##

sub open {
  my $self = shift;
  print 'call open()'."\n" if ($self->{debug});
  # restart TCP if already open
  $self->close if ($self->is_open);
  # name resolve
  my $ad_ip = inet_aton($self->{HOST});
  unless($ad_ip) {
    $self->{LAST_ERROR} = MB_RESOLVE_ERR;
    print 'IP resolve error'."\n" if ($self->{debug});
    return undef;
  }
  # set socket
  socket($self->{sock}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  my $connect_ok = connect($self->{sock}, sockaddr_in($self->{PORT}, $ad_ip));
  if ($connect_ok) {
    return 1;
  } else {
    $self->{sock} = undef;
    $self->{LAST_ERROR} = MB_CONNECT_ERR;
    print 'TCP connect error'."\n" if ($self->{debug});
    return undef;
  }
};

##
## Check TCP link.
##

sub is_open {
  my $self = shift;
  return (defined $self->{sock});
};

##
## Close TCP link.
##

sub close {
  my $self = shift;
  if ($self->{sock}) { 
    close $self->{sock};
    $self->{sock} = undef;
    return 1;
  } else {
    return undef;
  }
};

##
## Modbus function READ_COILS (0x01).
##   read_coils(bit_addr, bit_number)
##   return a ref to result array
##          or undef if error

sub read_coils {
  my $self     = shift;
  my $bit_addr = shift;
  my $bit_nb   = shift;
  # build frame
  my $tx_buffer = $self->_mbus_frame(READ_COILS, pack("nn", $bit_addr, $bit_nb));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_byte_count, $f_bits) = unpack 'Cb*', $f_body;
  # read bit(s) string
  my @bits = split //, $f_bits;
  $#bits = $bit_nb - 1;
  return \@bits;
}

##
## Modbus function READ_DISCRETE_INPUTS (0x02).
##   read_discrete_inputs(bit_addr, bit_number)
##   return a ref to result array
##          or undef if error

sub read_discrete_inputs {
  my $self     = shift;
  my $bit_addr = shift;
  my $bit_nb   = shift;
  # build frame
  my $tx_buffer = $self->_mbus_frame(READ_DISCRETE_INPUTS, pack("nn", $bit_addr, $bit_nb));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_byte_count, $f_bits) = unpack 'Cb*', $f_body;
  # read bit(s) string
  my @bits = split //, $f_bits;
  $#bits = $bit_nb - 1;
  return \@bits;
}


##
## Modbus function READ_HOLDING_REGISTERS (0x03).
##   read_holding_registers(reg_addr, reg_number)
##   return a ref to result array
##          or undef if error

sub read_holding_registers {
  my $self     = shift;
  my $reg_addr = shift;
  my $reg_nb   = shift;
  # build frame
  my $tx_buffer = $self->_mbus_frame(READ_HOLDING_REGISTERS, pack("nn", $reg_addr, $reg_nb));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_reg_count, $f_regs) = unpack 'Ca*', $f_body;
  # read 16 bits register
  my @registers = unpack 'n*', $f_regs;
  return \@registers;
}

##
## Modbus function READ_INPUT_REGISTERS (0x04).
##   read_input_registers(reg_addr, reg_number)
##   return a ref to result array
##          or undef if error

sub read_input_registers {
  my $self     = shift;
  my $reg_addr = shift;
  my $reg_nb   = shift;
  # build frame
  my $tx_buffer = $self->_mbus_frame(READ_INPUT_REGISTERS, pack("nn", $reg_addr, $reg_nb));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_reg_count, $f_regs) = unpack 'Ca*', $f_body;
  # read 16 bits register
  my @registers = unpack 'n*', $f_regs;
  return \@registers;
}

##
## Modbus function WRITE_SINGLE_COIL (0x05).
##   write_single_coil(bit_addr, bit_value)
##   return 1 if write success
##          or undef if error

sub write_single_coil {
  my $self      = shift;
  my $bit_addr  = shift;
  my $bit_value = shift;
  # build frame
  $bit_value = ($bit_value) ? 0xFF : 0;
  my $tx_buffer = $self->_mbus_frame(WRITE_SINGLE_COIL, pack("nC", $bit_addr, $bit_value));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_bit_addr, $rx_bit_value) = unpack 'nC', $f_body;
  # check bit write
  return (($rx_bit_addr == $bit_addr) and ($rx_bit_value == $bit_value)) ? 1 : undef;
}

##
## Modbus function WRITE_SINGLE_REGISTER (0x06).
##   write_single_register(reg_addr, reg_value)
##   return 1 if write success
##          or undef if error

sub write_single_register {
  my $self      = shift;
  my $reg_addr  = shift;
  my $reg_value = shift;
  # build frame
  my $tx_buffer = $self->_mbus_frame(WRITE_SINGLE_REGISTER, pack("nn", $reg_addr, $reg_value));
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_reg_addr, $rx_reg_value) = unpack 'nn', $f_body;
  # check bit write
  return (($rx_reg_addr == $reg_addr) and ($rx_reg_value == $reg_value)) ? 1 : undef;
}

##
## Modbus function WRITE_MULTIPLE_REGISTERS (0x10).
##   write_multiple_registers(reg_addr, ref_to_reg_array)
##   return 1 if write success
##          or undef if error

sub write_multiple_registers {
  my $self          = shift;
  my $reg_addr      = shift;
  my $ref_array_reg = shift;
  my @reg_value     = @$ref_array_reg;
  # build frame
  # register
  my $reg_nb = @reg_value;
  # format reg value string
  my $reg_val_str;
  for (@reg_value) {$reg_val_str .= pack("n", $_);}
  my $bytes_nb = bytes::length($reg_val_str);
  # format modbus frame body
  my $body = pack("nnC", $reg_addr, $reg_nb, $bytes_nb).$reg_val_str;
  my $tx_buffer = $self->_mbus_frame(WRITE_MULTIPLE_REGISTERS, $body);
  # send request
  my $s_send = $self->_send_mbus($tx_buffer);
  # check error
  return undef unless ($s_send);
  # receive
  my $f_body = $self->_recv_mbus();
  # check error
  return undef unless ($f_body);
  # register extract
  my ($rx_reg_addr, $rx_reg_nb) = unpack 'nn', $f_body;
  # check regs write
  return ($rx_reg_addr == $reg_addr) ? 1 : undef;
}

# Build modbus frame.
#   _mbus_frame(function code, body)
#   return modbus frame
sub _mbus_frame {
  my $self  = shift;
  my $fc    = shift;
  my $body  = shift;
  # build frame body
  my $f_body = pack("C", $fc).$body;
  # modbus/TCP
  if ($self->{MODE} == MODBUS_TCP) {
    # build frame ModBus Application Protocol header (mbap)
    $self->{hd_tr_id}    = int(rand 65535);
    my $tx_hd_pr_id      = 0;
    my $tx_hd_length     = bytes::length($f_body) + 1;
    my $f_mbap = pack("nnnC", $self->{hd_tr_id}, $tx_hd_pr_id,
                              $tx_hd_length, $self->{UNIT_ID});
    return $f_mbap.$f_body;
  # modbus RTU
  } elsif ($self->{MODE} == MODBUS_RTU) {
    # format [slave addr(unit_id)]frame_body[CRC16]
    my $slave_ad = pack("C", $self->{UNIT_ID});
    return $self->_add_crc($slave_ad.$f_body);
  } else {
  # unknow mode
    return undef;
  }
}

# Send modbus frame.
#   _send_mbus(frame)
#   return $nb_byte send 
sub _send_mbus {
  my $self  = shift;
  my $frame = shift;
  # send request
  my $bytes_send = $self->_send($frame);
  return undef unless ($bytes_send);
  # for debug
  $self->_pretty_dump('Tx', $frame) if ($self->{debug});
  # return
  return $bytes_send;
}

# Recv modbus frame.
#   _recv_mbus()
#   return body (after func. code) 
sub _recv_mbus {
  my $self  = shift;
  ## receive
  # vars
  my ($rx_buffer,$rx_frame);
  my ($rx_unit_id, $rx_bd_fc, $f_body);
  # modbus TCP receive
  if ($self->{MODE} == MODBUS_TCP) {
    # 7 bytes head
    $rx_buffer = $self->_recv(7);
    return undef unless($rx_buffer);
    $rx_frame = $rx_buffer;
    # decode
    my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_frame;
    # check
    if (!(($rx_hd_tr_id == $self->{hd_tr_id}) && ($rx_hd_pr_id == 0) &&
          ($rx_hd_length < 256) && ($rx_hd_unit_id == $self->{UNIT_ID}))) {
      $self->close;
      return undef;
    }
    # end of frame
    $rx_buffer = $self->_recv($rx_hd_length-1);
    return undef unless($rx_buffer);
    $rx_frame .= $rx_buffer;
    # dump frame
    $self->_pretty_dump('Rx', $rx_frame) if ($self->{debug});
    # body decode
    ($rx_bd_fc, $f_body) = unpack "Ca*", $rx_buffer;
  # modbus RTU receive
  } elsif ($self->{MODE} == MODBUS_RTU) {   
    $rx_buffer = $self->_recv(FRAME_RTU_MAXSIZE);
    return undef unless($rx_buffer);
    $rx_frame = $rx_buffer;
    # dump frame
    $self->_pretty_dump('Rx', $rx_frame) if ($self->{debug});
    # body decode
    ($rx_unit_id, $rx_bd_fc, $f_body) = unpack "CCa*", $rx_frame;
    # check
    if (!($rx_unit_id == $self->{UNIT_ID})) {
      $self->close;
      return undef;
    }
  }  
  # check except
  if ($rx_bd_fc > 0x80) {
    # except code
    my ($exp_code) = unpack "C", $f_body;
    $self->{LAST_ERROR}  = MB_EXCEPT_ERR;
    $self->{LAST_EXCEPT} = $exp_code;
    print 'except (code '.$exp_code.')'."\n" if ($self->{debug});
    return undef;
  } else {
    # return
    return $f_body;
  }
}

# Send data over current socket.
#   _send(data_to_send)
#   return the number of bytes send
#          or undef if error
sub _send {
  my $self = shift;
  my $data = shift;
  # check link, open if need
  unless ($self->is_open) {
    print 'call _send() not open -> call open()'."\n" if ($self->{debug});
    return undef unless ($self->open);
  }
  # send data
  my $data_l = bytes::length($data);
  my $send_l = send($self->{sock}, $data, 0);
  # send error
  if ($send_l != $data_l) {
    $self->{LAST_ERROR} = MB_SEND_ERR;
    print '_send error'."\n" if ($self->{debug});
    $self->close;
    return undef;
  } else {
    return $send_l;
  }
}

# Recv data over current socket.
#   _recv(max_size)
#   return the receive buffer
#          or undef if error
sub _recv {
  my $self     = shift;
  my $max_size = shift;
  # wait for read
  unless ($self->_can_read()) {
    $self->close;
    return undef;
  }
  # recv
  my $buffer;
  my $s_recv = recv($self->{sock}, $buffer, $max_size, 0);
  unless (defined $s_recv) {
    $self->{LAST_ERROR} = MB_RECV_ERR;
    print '_recv error'."\n" if ($self->{debug});
    $self->close;
    return undef;
  }
  return $buffer;
}

# Wait for socket read.
sub _can_read {
  my $self  = shift;
  my $hdl_select = "";
  vec($hdl_select, fileno($self->{sock}), 1) = 1;
  my $_select = select($hdl_select, undef, undef, $self->{timeout});
  if ($_select) {
    return $_select;
  } else {  
    $self->{LAST_ERROR} = MB_TIMEOUT_ERR;
    print 'timeout error'."\n" if ($self->{debug});
    $self->close;
    return undef;
  }
}

# Compute modbus CRC16 (for RTU mode).
#   _crc(modbus_frame)
#   return the CRC
sub _crc {
  my $self  = shift;
  my $frame = shift;
  my $crc = 0xFFFF;
  my ($chr, $lsb);
  for my $i (0..bytes::length($frame)-1) {
    $chr = ord(bytes::substr($frame, $i, 1));
    $crc ^= $chr;
    for (1..8) {
      $lsb = $crc & 1;
      $crc >>= 1;
      $crc ^= 0xA001 if $lsb;
      }
    }
  return $crc;
}

# Add CRC to modbus frame (for RTU mode).
#   _add_crc(modbus_frame)
#   return modbus_frame_with_crc
sub _add_crc {
  my $self  = shift;
  my $frame = shift;
  my $crc = pack 'v', $self->_crc($frame);
  return $frame.$crc;
}

# Check the CRC of modbus RTU frame.
#   _crc_is_ok(modbus_frame_with_crc)
#   return true if CRC is ok
sub _crc_is_ok {
  my $self  = shift;
  my $frame = shift;
  my $crc = unpack('v', bytes::substr($frame, -2));
  return ($crc == $self->_crc($frame));
}

# Print modbus/TCP frame ("[header]body") or modbus RTU ("body[CRC]").
sub _pretty_dump {
  my $self  = shift;
  my $label = shift;
  my $data  = shift;
  my @dump = map {sprintf "%02X", $_ } unpack("C*", $data);
  # format for TCP or RTU
  if ($self->{MODE} == MODBUS_TCP) {
    $dump[0] = "[".$dump[0];
    $dump[5] = $dump[5]."]";
  } elsif ($self->{MODE} == MODBUS_RTU) {
    $dump[$#dump-1] = "[".$dump[$#dump-1];
    $dump[$#dump] = $dump[$#dump]."]";
  }
  # print result
  print $label."\n";
  for (@dump) {print $_." ";}
  print "\n\n";
}

1;

__END__

=head1 NAME

MBclient - Add modbus TCP or RTU functions for your program.

=head1 SYNOPSIS

  use strict;
  use MBclient;

  my $m = MBclient->new();
  # define server target
  $m->host("localhost");
  $m->unit_id(1);

  # read 16 bits register from ad 0 to 9
  my $words = $m->read_holding_registers(0, 10);

  # print words
  foreach my $word (@$words) {
    print $word."\n";
  }

  # clean exit
  $m->close();
  exit 0;

=head1 DESCRIPTION

Modbus is a standard serial communication protocol used to interconnect industrial 
PLC (and a lot of other things). This module gives you access to TCP and RTU 
version of this protocol, through the MBclient object.

You can have a look at http://en.wikipedia.org/wiki/Modbus for details. 

=head1 USAGE

=head2 How you might use this

Here is how you I<might> use the MBclient module.

First you have to create the object, and to set main params : host, port and unit_id. 

Then call open() function, or directly a "modbus function". In any case, you have to call the close() method, in order 
to cleanly close the TCP link.

=head2 Functions

The following functions are defined in the MBclient module. Most of
them are I<public>, meaning that you're supposed to use
them. Some are I<private>, meaning that you're not supposed to use
them. Assume that functions are I<public>
unless otherwise documented.

=over

=item open()

open() funtion open the TCP link. If the TCP link is up when the function is
called a close/open cycle is initiated.

This function return undef in case of error.

Example: C<$m-E<gt>open();>

=item is_open()

is_open() return True if TCP link is open, False when TCP is closed

Example: C<$m-E<gt>is_open();>

=item close()

close() function close the TCP link.

Return True if success, undef if error.

Example: C<$m-E<gt>close();>

=item mode(MODBUS_MODE)

Use to set modbus mode : TCP (default value) or RTU (add crc16 on every frame).

2 constants are import with this module MODBUS_TCP and MODBUS_RTU. Use it to 
define modbus mode.

Example: C<$m-E<gt>mode(MODBUS_RTU);>

=item host(hostname)

Use to set server IPv4 like "192.168.0.1" or URL name like "plc1.domain.net".

Return "hostname" if success, undef in other case.

Example: C<$m-E<gt>host("192.168.0.1");>

You can read hostname property if you call host() without arg.

=item port(port)

Use to set server port (default is 502).

Return "port" if success, undef in other case.

Example: C<$m-E<gt>port(888);>

You can read port property if you call port() without arg.

=item unit_id(uid)

Use to set server modbus unit id (default is 1).

Return "uid" if success, undef in other case.

Example: C<$m-E<gt>unit_id(1);>

You can read port property if you call unit_id() without arg.

=item last_error()

last_error() return last error on MBclient object.

See source code for "module error code" list. 

Each error is a constant import in your program, so you can do thing like:

  if ($m->last_error() == MB_RESOLVE_ERR) {
    print "unable to resolve name\n";
    exit 2;
  }

=item last_except()

last_except() return last modbus exception code.

See source code for "modbus except code" list.

Each except is a constant import in your program, so you can do thing like:

  if ($m->last_except() == EXP_GATEWAY_PATH_UNAVAILABLE) {
    print "check your modbus gateway please\n";
    exit 3;
  }

=item version()

version() return current version.

Example: C<print $m-E<gt>version();>

=item read_coils(bit_addr, bit_nb)

read_coils() is standard modbus function 1.

This funtion read "bit_nb" number of bits at "bit_addr" bit address.

Return a ref to a bits array or undef if error.

Example read 10 bits at address 55:

  my $bits = $m->read_coils(55, 10);
  foreach my $bit ($@bits) {
    print $bit."\n";
  }

=item read_discrete_inputs(bit_addr, bit_nb)

read_discrete_inputs() is standard modbus function 2.

This funtion read "bit_nb" number of bits at "bit_addr" bit address.

Return a ref to a bits array or undef if error.

Example read 1 bit at hex address 45:
  
  my $bits = $m->read_discrete_inputs(1, 0x45);
  if ($bits) {
    print $$bits[0]."\n";
  } else {
    print "error code: ".$m->last_error()."\n";
  }

=item read_holding_registers(reg_addr, reg_nb)

read_holding_registers() is standard modbus function 3.

This funtion read "reg_nb" number of registers at "reg_addr" register address.

Return a ref to a registers array or undef if error.

Example read 2 registers at hex address 66:

  my $regs = $m->read_holding_registers(2, 0x66);
  foreach my $reg ($@regs) {
    print $reg."\n";
  }

=item read_input_registers(reg_addr, reg_nb)

read_input_registers() is standard modbus function 4.

This funtion read "reg_nb" number of registers at "reg_addr" register address.

Return a ref to a registers array or undef if error.

Example read 4 registers at hex address 100:

  my $regs = $m->read_input_registers(4, 0x100);
  foreach my $reg ($@regs) {
    print $reg."\n";
  }

=item write_single_coil(bit_addr, bit_value)

write_single_coil() is standard modbus function 5.

This funtion write "bit_value" (0 or 1) to "bit_addr" bit address.

Return True if write success, undef if error.

Example write 1 on bit at address 45:

  if ($m->write_single_coil(45, 1)) {
    print "write success\n";
  } else {
    print "write error\n";
  }


=item write_single_register(reg_addr, reg_value)

write_single_register() is standard modbus function 6.

This funtion write "reg_value" register value to "reg_addr" register address.

Return True if write success, undef if error.

Example write 578 on register at address 55:

  if ($m->write_single_register(55, 578)) {
    print "write success\n";
  } else {
    print "write error\n";
  }


=item write_multiple_registers(reg_addr, ref_array_reg)

write_multiple_registers() is standard modbus function 16.

This funtion write an array of register with reference to this array in 
"ref_array_reg" at "reg_addr" register address.

Return True if write success, undef if error.

Example write 3 registers at address 780:

  my @to_write = (45, 22, 33);
  if ($m->write_multiple_registers(780, \@to_write)) {
    print "write success\n";
  } else {
    print "write error\n";
  }

=item _mbus_frame(fc, body)

B<PRIVATE>

Build the modbus frame. Called with "fc" as function code and "body" as modbus
body frame.

Return the modbus frame or undef if error.

=item _send_mbus(frame)

B<PRIVATE>

Send "frame" over the current socket with debug pretty print option.

Return the number of byte send or undef if error.

=item _recv_mbus()

B<PRIVATE>

Receive modbus frame.

Return body of the modbus frame.

=item _send(data)

B<PRIVATE>

Send "data" over the current socket.

Return the number of byte send or undef if error.

=item _recv(max_size)

B<PRIVATE>

Receive "max_size" bytes of data from the current socket.

Return receive buffer or undef if error.

=item _can_read()

B<PRIVATE>

This function wait for data available on socket, block for a max of timeout 
second.

=item _crc(frame)

B<PRIVATE>

This function compute crc16 for arg "frame".

Return crc16.

=item _add_crc(frame)

B<PRIVATE>

Return modbus arg "frame" with crc16 at the end.

=item _crc_is_ok(frame)

B<PRIVATE>

Check the crc16 of modbus arg frame.

Return True if crc16 is ok, False in other case.

=item _pretty_dump(label, data)

B<PRIVATE>

Print modbus/TCP frame in pretty format.

=back

=head1 NOTES

- The file "examples/read_10_reg.pl " is provided as a basic script. You can use
it as a skeleton to start writing a modbus script.

- Advance users can enable debug messages with C<$m-E<gt>{debug}=1;>

=head1 BUGS

Thanks to report issues at https://github.com/sourceperl/MBclient/

=cut
