The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- 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;