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