lib/Thread/Semaphore.pm

   1 package Thread::Semaphore;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '2.08';
   7
   8 use threads::shared;
   9 use Scalar::Util 1.10 qw(looks_like_number);
  10
  11 # Create a new semaphore optionally with specified count (count defaults to 1)
  12 sub new {
  13     my $class = shift;
  14     my $val :shared = @_ ? shift : 1;
  15     if (!defined($val) ||
  16         ! looks_like_number($val) ||
  17         (int($val) != $val))
  18     {
  19         require Carp;
  20         $val = 'undef' if (! defined($val));
  21         Carp::croak("Semaphore initializer is not an integer: $val");
  22     }
  23     return bless(\$val, $class);
  24 }
  25
  26 # Decrement a semaphore's count (decrement amount defaults to 1)
  27 sub down {
  28     my $sema = shift;
  29     lock($$sema);
  30     my $dec = @_ ? shift : 1;
  31     if (! defined($dec) ||
  32         ! looks_like_number($dec) ||
  33         (int($dec) != $dec) ||
  34         ($dec < 1))
  35     {
  36         require Carp;
  37         $dec = 'undef' if (! defined($dec));
  38         Carp::croak("Semaphore decrement is not a positive integer: $dec");
  39     }
  40     cond_wait($$sema) until ($$sema >= $dec);
  41     $$sema -= $dec;
  42 }
  43
  44 # Increment a semaphore's count (increment amount defaults to 1)
  45 sub up {
  46     my $sema = shift;
  47     lock($$sema);
  48     my $inc = @_ ? shift : 1;
  49     if (! defined($inc) ||
  50         ! looks_like_number($inc) ||
  51         (int($inc) != $inc) ||
  52         ($inc < 1))
  53     {
  54         require Carp;
  55         $inc = 'undef' if (! defined($inc));
  56         Carp::croak("Semaphore increment is not a positive integer: $inc");
  57     }
  58     ($$sema += $inc) > 0 and cond_broadcast($$sema);
  59 }
  60
  61 1;
  62
  63 =head1 NAME
  64
  65 Thread::Semaphore - Thread-safe semaphores
  66
  67 =head1 VERSION
  68
  69 This document describes Thread::Semaphore version 2.08
  70
  71 =head1 SYNOPSIS
  72
  73     use Thread::Semaphore;
  74     my $s = Thread::Semaphore->new();
  75     $s->down();   # Also known as the semaphore P operation.
  76     # The guarded section is here
  77     $s->up();     # Also known as the semaphore V operation.
  78
  79     # The default semaphore value is 1
  80     my $s = Thread::Semaphore-new($initial_value);
  81     $s->down($down_value);
  82     $s->up($up_value);
  83
  84 =head1 DESCRIPTION
  85
  86 Semaphores provide a mechanism to regulate access to resources.  Unlike
  87 locks, semaphores aren't tied to particular scalars, and so may be used to
  88 control access to anything you care to use them for.
  89
  90 Semaphores don't limit their values to zero and one, so they can be used to
  91 control access to some resource that there may be more than one of (e.g.,
  92 filehandles).  Increment and decrement amounts aren't fixed at one either,
  93 so threads can reserve or return multiple resources at once.
  94
  95 =head1 METHODS
  96
  97 =over 8
  98
  99 =item ->new()
 100
 101 =item ->new(NUMBER)
 102
 103 C<new> creates a new semaphore, and initializes its count to the specified
 104 number (which must be an integer).  If no number is specified, the
 105 semaphore's count defaults to 1.
 106
 107 =item ->down()
 108
 109 =item ->down(NUMBER)
 110
 111 The C<down> method decreases the semaphore's count by the specified number
 112 (which must be an integer >= 1), or by one if no number is specified.
 113
 114 If the semaphore's count would drop below zero, this method will block
 115 until such time as the semaphore's count is greater than or equal to the
 116 amount you're C<down>ing the semaphore's count by.
 117
 118 This is the semaphore "P operation" (the name derives from the Dutch
 119 word "pak", which means "capture" -- the semaphore operations were
 120 named by the late Dijkstra, who was Dutch).
 121
 122 =item ->up()
 123
 124 =item ->up(NUMBER)
 125
 126 The C<up> method increases the semaphore's count by the number specified
 127 (which must be an integer >= 1), or by one if no number is specified.
 128
 129 This will unblock any thread that is blocked trying to C<down> the
 130 semaphore if the C<up> raises the semaphore's count above the amount that
 131 the C<down> is trying to decrement it by.  For example, if three threads
 132 are blocked trying to C<down> a semaphore by one, and another thread C<up>s
 133 the semaphore by two, then two of the blocked threads (which two is
 134 indeterminate) will become unblocked.
 135
 136 This is the semaphore "V operation" (the name derives from the Dutch
 137 word "vrij", which means "release").
 138
 139 =back
 140
 141 =head1 NOTES
 142
 143 Semaphores created by L<Thread::Semaphore> can be used in both threaded and
 144 non-threaded applications.  This allows you to write modules and packages
 145 that potentially make use of semaphores, and that will function in either
 146 environment.
 147
 148 =head1 SEE ALSO
 149
 150 Thread::Semaphore Discussion Forum on CPAN:
 151 L<http://www.cpanforum.com/dist/Thread-Semaphore>
 152
 153 Annotated POD for Thread::Semaphore:
 154 L<http://annocpan.org/~JDHEDDEN/Thread-Semaphore-2.08/lib/Thread/Semaphore.pm>
 155
 156 Source repository:
 157 L<http://code.google.com/p/thread-semaphore/>
 158
 159 L<threads>, L<threads::shared>
 160
 161 =head1 MAINTAINER
 162
 163 Jerry D. Hedden, S<E<lt>jdhedden AT cpan DOT orgE<gt>>
 164
 165 =head1 LICENSE
 166
 167 This program is free software; you can redistribute it and/or modify it under
 168 the same terms as Perl itself.
 169
 170 =cut