File Coverage

blib/lib/Protocol/Sys/Virt/KeepAlive.pm

Criterion	Covered	Total	%
statement	17	43	39.5
branch	0	8	0.0
condition			n/a
subroutine	6	17	35.2
pod	5	5	100.0
total	28	73	38.3

####################################################################
#
#     This file was generated using XDR::Parse version v1.0.1,
#        XDR::Gen version 1.1.2 and LibVirt version v12.1.0
#
#      Don't edit this file, use the source template instead
#
#                 ANY CHANGES HERE WILL BE LOST !
#
####################################################################

use v5.14;
use warnings;

package Protocol::Sys::Virt::KeepAlive v12.1.0;

use Carp qw(croak);
use Log::Any qw($log);

use Protocol::Sys::Virt::KeepAlive::XDR;
use Protocol::Sys::Virt::Transport::XDR;
my $msgs = 'Protocol::Sys::Virt::KeepAlive::XDR';
my $type = 'Protocol::Sys::Virt::Transport::XDR';

sub new {
    my ($class, %args) = @_;
    return bless {
        inactive     => 0,
        max_inactive => 10,
        on_ack       => sub { },
        on_fail      => sub { },
        on_ping      => sub { },
        sender       => sub { croak 'Not registered with a transport'; },
        %args
    }, $class;
}

sub _unexpected_msg {
    croak 'Unexpected message';
}

sub register {
    my ($self, $transport) = @_;

    $self->{sender} = $transport->register(
        $msgs->PROGRAM,
        $msgs->PROTOCOL_VERSION,
        {
            on_reply   => \&_unexpected_msg,
            on_call    => \&_unexpected_msg,
            on_message => sub {
                my %args = @_;

                if ($args{header}->{proc} == $msgs->PROC_PONG) {
                    $self->{inactive} = 0; # our PING; keep pinging
                    return $self->{on_ack}->($self, $transport);
                }

                $self->mark_active;
                if ($args{header}->{proc} == $msgs->PROC_PING) {
                    return $self->{on_ping}->($self, $transport);
                }
                return;
            },
            on_stream  => \&_unexpected_msg
        });
}


sub mark_active {
    $_[0]->{inactive} = -1; # external activity
}

sub ping {
    my ($self) = @_;

    $self->{inactive}++;
    if ($self->{inactive} > $self->{max_inactive}) {
        return $self->{on_fail}->($self);
    }
    if ($self->{inactive}) {
        $log->trace("Inactivity timer: $self->{inactive}");
        return $self->{sender}->($msgs->PROC_PING, $type->MESSAGE, data => '');
    }
    else {
        $log->trace("Activity found; no need to PING");
        return;
    }
}

sub pong {
    my ($self) = @_;
    $self->{sender}->($msgs->PROC_PONG, $type->MESSAGE, data => '');
}

1;

__END__