die "SysV semaphores are not implemented yet.  Send email to perl-loop@perl.org if you think this is a problem.  Thanks!\n";

package Event::semaphore;

use Event;
use IPC::Semaphore;

register Event;

my $LABEL = "sem000000";
my %SEM = ();

sub new {
    use attrs qw(locked method);

    my $class = shift;
    my %arg = @_;
    my $sem = $arg{'-semaphore'};
    my $op = $arg{'-op'};
    my $cb = $arg{'-callback'};

    croak 'Event->semaphore( -semaphore => $sem, -op => $arrayref, -callback => $coderef)'
	unless(UNIVERSAL::isa($msg,'IPC::Semaphore')
		&& UNIVERSAL::isa($op,'ARRAY')
		&& UNIVERSAL::isa($cb,'CODE'));

    my $obj = bless {
	callback  => $cb,
	semaphore => $sem,
	semop     => $op,
	label	  => $LABEL++,
    }, $class;
    $SEM{$obj->{'label'}} = $obj;
    $obj;
}

sub prepare { 3600 }

sub check {
    my $obj;
    my @del = ();
    foreach $obj (values %SEM) {
	if($obj->{'semaphore'}->op(@{$obj->{'semop'}}) >= 0) {
	    my($o,$cb,$s,$op) = ($obj,$obj->{'callback'},
				$obj->{'semaphore'},$obj->{'semop'});
	    Event->queueEvent( sub { $cb->($o,$s) } );
	    push @del, $obj->{'label'};
	}
    }
    delete @sem{@del};
    1;
}

sub cancel {
    my $self = shift;
    delete $SEM{$self->{'label'}};
}

sub again {
    my $self = shift;
    $SEM{$self->{'label'}} = $self;
}

1;