La séptima vida

...o el gato así lo espera/teme

AnyEvent Modbus server

Following the last experience with the hyper-simple AnyEvent server that echoes back what you write, here is my first attempt at writing a Modbus server.

The new server inherits from Device::Modbus::Server. This way, the method that executes server code based on client requests is already there. We gain the capability of working with units and the definition of server code.

On the other hand, parsing of requests was not that easy. The method which performs the parsing had to be rewritten since the execution of the program was no longer linear, or procedural. The resulting routine is quite long and I am sure it will be difficult to debug when the time arrives.

But let's discuss the code. I would say that the best entry point would be the following method, which starts the server:

sub start {
    my $self  = shift;
    my $guard; $guard = tcp_server( $self->host, $self->port, sub {
        my ($fh, $host, $port) = @_;
        # If the file handle is not defined, there is a problem
        if (!defined $fh) {
            AE::log error => "Could not start server: $!";

        my $handle; $handle = AnyEvent::Handle->new(
            fh        => $fh,
            keepalive => 1,
            on_read   => sub {
                my $handle = shift;
            on_eof   => sub {
                AE::log info => "Client disconnected";
            on_error => sub {
                my ($handle, $fatal, $msg) = @_;
                AE::log error => $msg;
                undef $guard;
    return $guard;

It is not too different from the previous article on AnyEvent servers. The Modbus server is also using AnyEvent::Socket for its tcp_server method, which returns a file handle from which we will read requests and write responses. It also uses AnyEvent::Handle to simplify the process of working directly with sockets. This is the approach discussed in the article cited above.

The complexity lies, as you can imagine, in the process_request method of the server object. This is the method that parses the request, processes it, and writes the response back to the client.

In event-land, your code executes only when the relevant event happens and, as two reads are needed to parse a request (one for the header and the second for the length-varying body), it is necessary to break the parsing of requests in two parts. Each one of these two parts is contained in a different callback. Because it is not possible to return values from these callbacks, the variables which will hold callback results have to be built in the same scope as the callbacks themselves. There are five different families of requests which have to be treated in the same scope. So, the method which parses requests needs to declare the variables that will be shared among the callbacks, the callbacks themselves, and the processing of the requests.

This is an example that parses only reading requests. I did not include the other types of requests to make the explanation simpler:

# Called when there is a new request
sub process_request {
    my ($self, $handle) = @_;

    # Two reads have to be made. First we read the header.
    $handle->unshift_read( chunk => 8, sub {
        my ($handle, $data) = @_;
        # Read header.
        my ($id, $proto, $length, $unit, $code) = unpack 'nnnCC', $data;
        my $request;
        my $adu_req = Device::Modbus::TCP::ADU->new(
            id      => $id,
            unit    => $unit,

        # This routine is common for all requests.
        # It is called when the request has been parsed, at the end of the
        # second reading.
        my $process_request = sub {
            my $handle = shift;

            # Process the request
            my $response = $self->modbus_server($adu_req);

            # Build the response ADU
            my $adu = Device::Modbus::TCP::ADU->new(
                id      => $id,
                unit    => $unit,
                message => $response
            # Send the response to the client

        # Read the rest of the incoming ADU to parse the request.
        # We read $length-2 because length includes unit and code bytes.
        $handle->unshift_read(chunk => $length - 2, sub {
            foreach ($code) {
                when ([0x01, 0x02, 0x03, 0x04]) {
                    # Read coils, discrete inputs, holding registers, input registers
                    my ($address, $quantity) = unpack 'nn', $_[1];
                    $request = Device::Modbus::Request->new(
                        code       => $code,
                        address    => $address,
                        quantity   => $quantity
                default {
                    # Unimplemented function
                    $request = Device::Modbus::Exception->new(
                        code           => $code + 0x80,
                        exception_code => 1,

As you can see, the variable $process_request contains a code reference which is executed once the request is known. It uses the variable $request, which is already declared but its value is unknown until the execution of the second reading callback. This code reference is the heart of the Modbus server, as it analyses the request from the client and it builds the response. Note also that $process_request pushes a write request into the AnyEvent handle's queue to send the binary representation of the response object.

For testing, I used the same code as for the article about communicating the Modbus server with a database. The script that calls the above server looks like this:

#! /usr/bin/env perl

use Device::Modbus::AnyEvent::TCP::Server;
use Test::Unit;
use strict;
use warnings;
use v5.10;

my $server = Device::Modbus::AnyEvent::TCP::Server->new(
    host => '',
    port => 8765,

my $unit = Test::Unit->new(id => 1);

my $cv = AnyEvent->condvar;

my $guard = $server->start;

my $exit = AnyEvent->signal(
    signal => 'INT',
    cb     => sub {
        undef $guard;

say "In the loop";
say "Over"

And using the same client as with the other article, I get the following output in the server terminal:

julio@julio-lap$ perl -Ilib -It
In the loop

Note that I stopped the server with Ctrl-C.

In the client terminal, I got:

julio@julio-lap$ perl 
Values: 6-45-20-15

And this is it for this article. The next step is uploading the module to GitHub. Then I want to document it, to add some tests, and to play with further examples. It would be more than interesting to write a server that works as a gateway to a MQTT client. I think this way the program will be very simple, as will the clients at the other side of the MQTT conversation.