view release on metacpan or  search on metacpan

lib/BACnet/Socket.pm  view on Meta::CPAN

#!/usr/bin/perl

package BACnet::Socket;

use v5.16;

use Data::Dumper;

use Future::AsyncAwait;
use IO::Async::Socket;
use IO::Async::Loop;
use Socket qw(unpack_sockaddr_in inet_ntoa pack_sockaddr_in inet_aton);

use BACnet::Device;

use Scalar::Util 'weaken';

my $BACNET_PORT = 0xBAC0;    # 47808

sub new {
    my ( $class, $device, %args ) = @_;

    weaken { $device };

    my $self = {
        retries => $args{retries} // 3,
        timeout => $args{timeout} // 3,
        loop    => $args{io_loop} // IO::Async::Loop->new,
        debug   => $args{debug},
        stime   => time,           # for debugging timestamps
        device  => $device,
        locks   => {},
    };
    bless $self, $class;

    $self->{sock} =
      IO::Async::Socket->new( on_recv => sub { $self->_recv(@_) }, );

    $self->loop->add( $self->{sock} );
    $self->sock->bind(
        socktype => 'dgram',
        addr     => $args{addr},
        service  => $args{sport} // 0,
    )->get;    # local bind() does not block

    return $self;
}

sub _stop {

    my ($self) = @_;

    $self->loop->delay_future( after => 2, )->on_done(
        sub {
            $self->loop->stop;
        }
    );
}

sub _debug {
    my ( $self, @msg ) = @_;
    return if !$self->{debug};
    say STDERR sprintf( "+%04ds", time - $self->{stime} ), ' ', @msg;
}

sub _recv {
    my ( $self, $sock, $dgram, $addr ) = @_;

    my ( $port, $ip ) = unpack_sockaddr_in($addr);
    my $ipaddr = inet_ntoa($ip);
    $self->_debug("got packet from $ipaddr:$port");

    my $packet = BACnet::BVLC->parse($dgram);

    $self->_debug( join( ' ', '< recv', unpack( "(H2)*", $dgram ) ) );

    if (
           defined $packet->{payload}
        && defined $packet->{payload}->{invoke_id}
        && defined $self->{reader_of}
        { $addr . ':' . $packet->{payload}{invoke_id} }
        && _is_response(
            $self->{reader_of}{ $addr . ':' . $packet->{payload}{invoke_id} }