ext/Thread/Thread/Semaphore.pm

   1 package Thread::Semaphore;
   2 use Thread qw(cond_wait cond_broadcast);
   3
   4 sub new {
   5     my $class = shift;
   6     my $val = @_ ? shift : 1;
   7     bless \$val, $class;
   8 }
   9
  10 sub down {
  11     use attrs qw(locked method);
  12     my $s = shift;
  13     my $inc = @_ ? shift : 1;
  14     cond_wait $s until $$s >= $inc;
  15     $$s -= $inc;
  16 }
  17
  18 sub up {
  19     use attrs qw(locked method);
  20     my $s = shift;
  21     my $inc = @_ ? shift : 1;
  22     ($$s += $inc) > 0 and cond_broadcast $s;
  23 }
  24
  25 1;