ext/Thread/Thread/Semaphore.pm

   1 package Thread::Semaphore;
   2 use Thread qw(cond_wait cond_broadcast);
   3
   4 =head1 NAME
   5
   6 Thread::Semaphore - thread-safe semaphores
   7
   8 =head1 SYNOPSIS
   9
  10     use Thread::Semaphore;
  11     my $s = new Thread::Semaphore;
  12     $s->up;     # Also known as the semaphore V -operation.
  13     # The guarded section is here
  14     $s->down;   # Also known as the semaphore P -operation.
  15
  16     # The default semaphore value is 1.
  17     my $s = new Thread::Semaphore($initial_value);
  18     $s->up($up_value);
  19     $s->down($up_value);
  20
  21 =cut
  22
  23 sub new {
  24     my $class = shift;
  25     my $val = @_ ? shift : 1;
  26     bless \$val, $class;
  27 }
  28
  29 sub down {
  30     use attrs qw(locked method);
  31     my $s = shift;
  32     my $inc = @_ ? shift : 1;
  33     cond_wait $s until $$s >= $inc;
  34     $$s -= $inc;
  35 }
  36
  37 sub up {
  38     use attrs qw(locked method);
  39     my $s = shift;
  40     my $inc = @_ ? shift : 1;
  41     ($$s += $inc) > 0 and cond_broadcast $s;
  42 }
  43
  44 1;