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;