Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
echo.t	759 B	-rw-r--r--
group.t	571 B	-rw-r--r--
idle2.t	1.2 KB	-rw-r--r--
msg.pm	1016 B	-rw-r--r--
perlqt.t	2.45 KB	-rw-r--r--
process.pm	1.59 KB	-rw-r--r--
queue_pending.t	792 B	-rw-r--r--
rand_interval.t	323 B	-rw-r--r--
readline.t	2.28 KB	-rw-r--r--
repeat.t	1005 B	-rw-r--r--
semaphore.pm	1.28 KB	-rw-r--r--

Code Editor : semaphore.pm

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;

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;
}

${this.title}

Code Editor : semaphore.pm