lib/Thread/Semaphore.pm

   1 package Thread::Semaphore;
   2 use Thread qw(cond_wait cond_broadcast);
   3
   4 our $VERSION = '1.00';
   5
   6 BEGIN {
   7     use Config;
   8     $ithreads = $Config{useithreads};
   9     $othreads = $Config{use5005threads};
  10     if($ithreads) {
  11         require 'threads/shared/semaphore.pm';
  12         for my $m (qw(new up down)) {
  13             no strict 'refs';
  14             *{"Thread::Semaphore::$m"} = \&{"threads::shared::semaphore::${m}"};
  15         }
  16     } else {
  17         for my $m (qw(new up down)) {
  18             no strict 'refs';
  19             *{"Thread::Semaphore::$m"} = \&{"Thread::Semaphore::${m}_othread"};
  20         }
  21     }
  22 }
  23
  24
  25 =head1 NAME
  26
  27 Thread::Semaphore - thread-safe semaphores
  28
  29 =head1 SYNOPSIS
  30
  31     use Thread::Semaphore;
  32     my $s = new Thread::Semaphore;
  33     $s->up;     # Also known as the semaphore V -operation.
  34     # The guarded section is here
  35     $s->down;   # Also known as the semaphore P -operation.
  36
  37     # The default semaphore value is 1.
  38     my $s = new Thread::Semaphore($initial_value);
  39     $s->up($up_value);
  40     $s->down($up_value);
  41
  42 =head1 DESCRIPTION
  43
  44 Semaphores provide a mechanism to regulate access to resources. Semaphores,
  45 unlike locks, aren't tied to particular scalars, and so may be used to
  46 control access to anything you care to use them for.
  47
  48 Semaphores don't limit their values to zero or one, so they can be used to
  49 control access to some resource that may have more than one of. (For
  50 example, filehandles) Increment and decrement amounts aren't fixed at one
  51 either, so threads can reserve or return multiple resources at once.
  52
  53 =head1 FUNCTIONS AND METHODS
  54
  55 =over 8
  56
  57 =item new
  58
  59 =item new NUMBER
  60
  61 C<new> creates a new semaphore, and initializes its count to the passed
  62 number. If no number is passed, the semaphore's count is set to one.
  63
  64 =item down
  65
  66 =item down NUMBER
  67
  68 The C<down> method decreases the semaphore's count by the specified number,
  69 or one if no number has been specified. If the semaphore's count would drop
  70 below zero, this method will block until such time that the semaphore's
  71 count is equal to or larger than the amount you're C<down>ing the
  72 semaphore's count by.
  73
  74 =item up
  75
  76 =item up NUMBER
  77
  78 The C<up> method increases the semaphore's count by the number specified,
  79 or one if no number's been specified. This will unblock any thread blocked
  80 trying to C<down> the semaphore if the C<up> raises the semaphore count
  81 above what the C<down>s are trying to decrement it by.
  82
  83 =back
  84
  85 =cut
  86
  87 sub new_othread {
  88     my $class = shift;
  89     my $val = @_ ? shift : 1;
  90     bless \$val, $class;
  91 }
  92
  93 sub down_othread : locked : method {
  94     my $s = shift;
  95     my $inc = @_ ? shift : 1;
  96     cond_wait $s until $$s >= $inc;
  97     $$s -= $inc;
  98 }
  99
 100 sub up_othread : locked : method {
 101     my $s = shift;
 102     my $inc = @_ ? shift : 1;
 103     ($$s += $inc) > 0 and cond_broadcast $s;
 104 }
 105
 106 1;