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     cond_wait $s until $$s > 0;
  14     $$s--;
  15 }
  16
  17 sub up {
  18     use attrs qw(locked method);
  19     my $s = shift;
  20     $$s++ > 0 and cond_broadcast $s;
  21 }
  22
  23 1;