File Coverage

blib/lib/Coro/SemaphoreSet.pm
Criterion Covered Total %
statement 6 21 28.5
branch 0 6 0.0
condition 0 18 0.0
subroutine 2 12 16.6
pod 8 8 100.0
total 16 65 24.6


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Coro::SemaphoreSet - efficient set of counting semaphores
4              
5             =head1 SYNOPSIS
6              
7             use Coro;
8              
9             $sig = new Coro::SemaphoreSet [initial value];
10              
11             $sig->down ("semaphoreid"); # wait for signal
12              
13             # ... some other "thread"
14              
15             $sig->up ("semaphoreid");
16              
17             =head1 DESCRIPTION
18              
19             This module implements sets of counting semaphores (see
20             L). It is nothing more than a hash with normal semaphores
21             as members, but is more efficiently managed.
22              
23             This is useful if you want to allow parallel tasks to run in parallel but
24             not on the same problem. Just use a SemaphoreSet and lock on the problem
25             identifier.
26              
27             You don't have to load C manually, it will be loaded
28             automatically when you C and call the C constructor.
29              
30             =over 4
31              
32             =cut
33              
34             package Coro::SemaphoreSet;
35              
36 1     1   644 use common::sense;
  1         2  
  1         5  
37              
38             our $VERSION = 6.513;
39              
40 1     1   50 use Coro::Semaphore ();
  1         2  
  1         396  
41              
42             =item new [initial count]
43              
44             Creates a new semaphore set with the given initial lock count for each
45             individual semaphore. See L.
46              
47             =cut
48              
49             sub new {
50 0 0   0     bless [defined $_[1] ? $_[1] : 1], $_[0]
51             }
52              
53             =item $semset->down ($id)
54              
55             Decrement the counter, therefore "locking" the named semaphore. This
56             method waits until the semaphore is available if the counter is zero.
57              
58             =cut
59              
60             sub down {
61             # Coro::Semaphore::down increases the refcount, which we check in _may_delete
62 0   0 0 1   Coro::Semaphore::down ($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]);
63             }
64              
65             #ub timed_down {
66             # require Coro::Timer;
67             # my $timeout = Coro::Timer::timeout ($_[2]);
68             #
69             # while () {
70             # my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);
71             #
72             # if ($sem->[0] > 0) {
73             # --$sem->[0];
74             # return 1;
75             # }
76             #
77             # if ($timeout) {
78             # # ugly as hell.
79             # for (0..$#{$sem->[1]}) {
80             # if ($sem->[1][$_] == $Coro::current) {
81             # splice @{$sem->[1]}, $_, 1;
82             # return 0;
83             # }
84             # }
85             # die;
86             # }
87             #
88             # push @{$sem->[1]}, $Coro::current;
89             # &Coro::schedule;
90             # }
91             #
92              
93             =item $semset->up ($id)
94              
95             Unlock the semaphore again. If the semaphore reaches the default count for
96             this set and has no waiters, the space allocated for it will be freed.
97              
98             =cut
99              
100             sub up {
101 0     0 1   my ($self, $id) = @_;
102              
103 0   0       my $sem = $self->[1]{$id} ||= Coro::Semaphore::_alloc $self->[0];
104              
105 0           Coro::Semaphore::up $sem;
106              
107 0 0         delete $self->[1]{$id}
108             if _may_delete $sem, $self->[0], 1;
109             }
110              
111             =item $semset->try ($id)
112              
113             Try to C the semaphore. Returns true when this was possible,
114             otherwise return false and leave the semaphore unchanged.
115              
116             =cut
117              
118             sub try {
119             Coro::Semaphore::try (
120 0 0 0 0 1   $_[0][1]{$_[1]} ||= $_[0][0] > 0
121             ? Coro::Semaphore::_alloc $_[0][0]
122             : return 0
123             )
124             }
125              
126             =item $semset->count ($id)
127              
128             Return the current semaphore count for the specified semaphore.
129              
130             =cut
131              
132             sub count {
133 0   0 0 1   Coro::Semaphore::count ($_[0][1]{$_[1]} || return $_[0][0]);
134             }
135              
136             =item $semset->waiters ($id)
137              
138             Returns the number (in scalar context) or list (in list context) of
139             waiters waiting on the specified semaphore.
140              
141             =cut
142              
143             sub waiters {
144 0   0 0 1   Coro::Semaphore::waiters ($_[0][1]{$_[1]} || return);
145             }
146              
147             =item $semset->wait ($id)
148              
149             Same as Coro::Semaphore::wait on the specified semaphore.
150              
151             =cut
152              
153             sub wait {
154 0   0 0 1   Coro::Semaphore::wait ($_[0][1]{$_[1]} || return);
155             }
156              
157             =item $guard = $semset->guard ($id)
158              
159             This method calls C and then creates a guard object. When the guard
160             object is destroyed it automatically calls C.
161              
162             =cut
163              
164             sub guard {
165 0     0 1   &down;
166 0           bless [@_], Coro::SemaphoreSet::guard::
167             }
168              
169             #ub timed_guard {
170             # &timed_down
171             # ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
172             # : ();
173             #
174              
175             sub Coro::SemaphoreSet::guard::DESTROY {
176 0     0     up @{$_[0]};
  0            
177             }
178              
179             =item $semaphore = $semset->sem ($id)
180              
181             This SemaphoreSet version is based on Coro::Semaphore's. This function
182             creates (if necessary) the underlying Coro::Semaphore object and returns
183             it. You may legally call any Coro::Semaphore method on it, but note that
184             calling C<< $semset->up >> can invalidate the returned semaphore.
185              
186             =cut
187              
188             sub sem {
189 0   0 0 1   bless +($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]),
190             Coro::Semaphore::;
191             }
192              
193             1;
194              
195             =back
196              
197             =head1 AUTHOR/SUPPORT/CONTACT
198              
199             Marc A. Lehmann
200             http://software.schmorp.de/pkg/Coro.html
201              
202             =cut
203