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