Commit | Line | Data |
d21067e0 |
1 | package Thread::Semaphore; |
2 | use Thread qw(cond_wait cond_broadcast); |
3 | |
d516a115 |
4 | =head1 NAME |
5 | |
6 | Thread::Semaphore - thread-safe semaphores |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | use Thread::Semaphore; |
11 | my $s = new Thread::Semaphore; |
12 | $s->up; # Also known as the semaphore V -operation. |
13 | # The guarded section is here |
14 | $s->down; # Also known as the semaphore P -operation. |
15 | |
16 | # The default semaphore value is 1. |
17 | my $s = new Thread::Semaphore($initial_value); |
18 | $s->up($up_value); |
19 | $s->down($up_value); |
20 | |
21 | =cut |
22 | |
d21067e0 |
23 | sub new { |
24 | my $class = shift; |
25 | my $val = @_ ? shift : 1; |
26 | bless \$val, $class; |
27 | } |
28 | |
29 | sub down { |
30 | use attrs qw(locked method); |
31 | my $s = shift; |
0a00ffdb |
32 | my $inc = @_ ? shift : 1; |
33 | cond_wait $s until $$s >= $inc; |
34 | $$s -= $inc; |
d21067e0 |
35 | } |
36 | |
37 | sub up { |
38 | use attrs qw(locked method); |
39 | my $s = shift; |
0a00ffdb |
40 | my $inc = @_ ? shift : 1; |
41 | ($$s += $inc) > 0 and cond_broadcast $s; |
d21067e0 |
42 | } |
43 | |
44 | 1; |