# -*- perl -*-
use strict;
use warnings;
use Test::More tests => 23;
my $URI = "test:///default";
my $DOM = "test";
BEGIN {
use_ok('Sys::Virt');
}
package Sys::Virt::Event::Simple;
use Time::HiRes qw(gettimeofday);
use base qw(Sys::Virt::Event);
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
$self->{nexthandle} = 1;
$self->{handles} = [];
$self->{nexttimeout} = 1;
$self->{timeouts} = [];
bless $self, $class;
$self->register;
return $self;
}
sub _now {
my $self;
my @now = gettimeofday;
return $now[0] * 1000 + (($now[1] - ($now[1] % 1000)) / 1000);
}
sub _bits {
my $self = shift;
my $event = shift;
my $vec = '';
my $count = 0;
foreach my $handle (@{$self->{handles}}) {
next unless $handle->{events} & $event;
$count++;
vec($vec, $handle->{fd}, 1) = 1;
}
return ($vec, $count);
}
sub run_once {
my $self = shift;
my ($ri, $ric) = $self->_bits(Sys::Virt::Event::HANDLE_READABLE);
my ($wi, $wic) = $self->_bits(Sys::Virt::Event::HANDLE_WRITABLE);
my ($ei, $eic) = $self->_bits(Sys::Virt::Event::HANDLE_READABLE |
Sys::Virt::Event::HANDLE_WRITABLE);
my $timeout = $self->_timeout($self->_now);
if (!$ric && !$wic && !$eic && !(defined $timeout)) {
return;
}
my ($ro, $wo, $eo);
my $n = select($ro=$ri,$wo=$wi,$eo=$ei,
(defined $timeout ? ($timeout ? $timeout/1000 : 0) : undef));
if ($n) {
$self->_dispatch_handles($ro, $wo, $eo);
}
$self->_dispatch_timeouts($self->_now);
return 1;
}
sub run {
my $self = shift;
$self->{shutdown} = 0;
while (!$self->{shutdown}) {
$self->_run_once();
}
}
sub _dispatch_handles {
my $self = shift;
my $ro = shift;
my $wo = shift;
my $eo = shift;
foreach my $handle (@{$self->{handles}}) {
my $events = 0;
if (vec($ro, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_READABLE;
}
if (vec($wo, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_WRITABLE;
}
if (vec($eo, $handle->{fd}, 1)) {
$events |= Sys::Virt::Event::HANDLE_ERROR;
}
if ($events) {
$self->_run_handle_callback($handle->{watch},
$handle->{fd},
$events,
$handle->{cb},
$handle->{opaque});
}
}
}
sub _timeout {
my $self = shift;
my $now = shift;
my $ret = undef;
foreach my $timeout (@{$self->{timeouts}}) {
if ($timeout->{interval} != -1) {
my $wait = $timeout->{expiresAt} - $now;
$wait = 0 if $wait < 0;
$ret = $wait if !defined($ret) || $wait < $ret;
}
}
return $ret;
}
sub _dispatch_timeouts {
my $self = shift;
my $now = shift;
foreach my $timeout (@{$self->{timeouts}}) {
if ($timeout->{interval} != -1 &&
$now >= $timeout->{expiresAt}) {
$self->_run_timeout_callback($timeout->{timer},
$timeout->{cb},
$timeout->{opaque});
$timeout->{expiresAt} = $now + $timeout->{interval};
}
}
}
sub add_handle {
my $self = shift;
my $fd = shift;
my $events = shift;
my $cb = shift;
my $opaque = shift;
my $ff = shift;
my $handle = {
fd => $fd,
events => $events,
cb => $cb,
opaque => $opaque,
ff => $ff,
watch => $self->{nexthandle}++,
};
push @{$self->{handles}}, $handle;
return $handle->{watch};
}
sub update_handle {
my $self = shift;
my $watch = shift;
my $events = shift;
my @handle = grep { $_->{watch} == $watch } @{$self->{handles}};
$handle[0]->{events} = $events;
}
sub remove_handle {
my $self = shift;
my $watch = shift;
my @handle = grep { $_->{watch} == $watch } @{$self->{handles}};
my @handles = grep { $_->{watch} != $watch } @{$self->{handles}};
$self->{handles} = \@handles;
$self->_free_callback_opaque($handle[0]->{ff},
$handle[0]->{opaque});
}
sub add_timeout {
my $self = shift;
my $interval = shift;
my $cb = shift;
my $opaque = shift;
my $ff = shift;
my $timeout = {
interval => $interval,
cb => $cb,
opaque => $opaque,
ff => $ff,
timer => $self->{nexttimeout}++,
expiresAt => $self->_now() + $interval,
};
push @{$self->{timeouts}}, $timeout;
return $timeout->{timer};
}
sub update_timeout {
my $self = shift;
my $timer = shift;
my $interval = shift;
my @timeout = grep { $_->{timer} == $timer } @{$self->{timeouts}};
$timeout[0]->{interval} = $interval;
$timeout[0]->{expiresAt} = $self->_now() + $interval;
}
sub remove_timeout {
my $self = shift;
my $timer = shift;
my @timeout = grep { $_->{timer} == $timer } @{$self->{timeouts}};
my @timeouts = grep { $_->{timer} != $timer } @{$self->{timeouts}};
$self->{timeouts} = \@timeouts;
$self->_free_callback_opaque($timeout[0]->{ff},
$timeout[0]->{opaque});
}
package main;
my $ev = Sys::Virt::Event::Simple->new();
my $conn = Sys::Virt->new(uri => $URI);
isa_ok($conn, "Sys::Virt");
my $dom = $conn->get_domain_by_name($DOM);
my @events;
$conn->domain_event_register(
sub {
my $con = shift;
my $dom = shift;
my $event = shift;
my $detail = shift;
push @events, [$con, $dom, $event, $detail];
});
$dom->destroy;
$ev->run_once();
is(int(@events), 1, "got 1st event");
is($events[0]->[0]->get_uri(), $URI, "got URI");
is($events[0]->[1]->get_name(), $DOM, "got name");
is($events[0]->[2], Sys::Virt::Domain::EVENT_STOPPED, "stopped");
is($events[0]->[3], Sys::Virt::Domain::EVENT_STOPPED_DESTROYED, "destroy");
$dom->create;
$ev->run_once();
is(int(@events), 2, "got 2nd event");
is($events[1]->[0]->get_uri(), $URI, "got URI");
is($events[1]->[1]->get_name(), $DOM, "got name");
is($events[1]->[2], Sys::Virt::Domain::EVENT_STARTED, "started");
is($events[1]->[3], Sys::Virt::Domain::EVENT_STARTED_BOOTED, "booted");
$conn->domain_event_deregister;
my $id = $conn->domain_event_register_any(
undef, Sys::Virt::Domain::EVENT_ID_LIFECYCLE,
sub {
my $con = shift;
my $dom = shift;
my $event = shift;
my $detail = shift;
push @events, [$con, $dom, $event, $detail];
});
$dom->destroy;
$ev->run_once();
is(int(@events), 3, "got 3rd event");
is($events[2]->[0]->get_uri(), $URI, "got URI");
is($events[2]->[1]->get_name(), $DOM, "got name");
is($events[2]->[2], Sys::Virt::Domain::EVENT_STOPPED, "stopped");
is($events[2]->[3], Sys::Virt::Domain::EVENT_STOPPED_DESTROYED, "destroy");
$dom->create;
$ev->run_once();
is(int(@events), 4, "got 4th event");
is($events[3]->[0]->get_uri(), $URI, "got URI");
is($events[3]->[1]->get_name(), $DOM, "got name");
is($events[3]->[2], Sys::Virt::Domain::EVENT_STARTED, "started");
is($events[3]->[3], Sys::Virt::Domain::EVENT_STARTED_BOOTED, "booted");
$conn->domain_event_deregister_any($id);
$dom->destroy;
$ev->run_once();
is(int(@events), 4, "no more events");
$conn = undef;