ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Semaphore.pm
(Generate patch)

Comparing Coro/Coro/Semaphore.pm (file contents):
Revision 1.10 by root, Wed Jul 25 04:14:38 2001 UTC vs.
Revision 1.55 by root, Wed Mar 7 13:11:10 2007 UTC

… …
14 14
15 $sig->up; 15 $sig->up;
16 16
17=head1 DESCRIPTION 17=head1 DESCRIPTION
18 18
19This module implements counting semaphores. You can initialize a mutex
20with any level of parallel users, that is, you can intialize a sempahore
21that can be C<down>ed more than once until it blocks. There is no owner
22associated with semaphores, so one coroutine can C<down> it while another
23can C<up> it.
24
25Counting semaphores are typically used to coordinate access to
26resources, with the semaphore count initialized to the number of free
27resources. Coroutines then increment the count when resources are added
28and decrement the count when resources are removed.
29
19=over 4 30=over 4
20 31
21=cut 32=cut
22 33
23package Coro::Semaphore; 34package Coro::Semaphore;
24 35
36BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
37
25use Coro (); 38use Coro ();
26 39
27$VERSION = 0.12; 40$VERSION = 1.9;
28 41
29=item new [inital count, default zero] 42=item new [inital count]
30 43
31Creates a new sempahore object with the given initial lock count. The 44Creates a new sempahore object with the given initial lock count. The
32default lock count is 1, which means it is unlocked by default. 45default lock count is 1, which means it is unlocked by default. Zero (or
46negative values) are also allowed, in which case the semaphore is locked
47by default.
33 48
34=cut 49=cut
35 50
36sub new { 51sub new {
37 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52 bless [defined $_[1] ? $_[1] : 1], $_[0];
38} 53}
39 54
55=item $sem->count
56
57Returns the current semaphore count.
58
59=cut
60
61sub count {
62 $_[0][0]
63}
64
40=item $sem->down 65=item $sem->down
41 66
42Decrement the counter, therefore "locking" the semaphore. This method 67Decrement the counter, therefore "locking" the semaphore. This method
43waits until the semaphore is available if the counter is zero. 68waits until the semaphore is available if the counter is zero.
44 69
70=item $status = $sem->timed_down($timeout)
71
72Like C<down>, but returns false if semaphore couldn't be acquired within
73$timeout seconds, otherwise true.
74
45=cut 75=cut
46 76
47sub down { 77sub down {
48 my $self = shift;
49 while ($self->[0] <= 0) { 78 while ($_[0][0] <= 0) {
50 push @{$self->[1]}, $Coro::current; 79 push @{$_[0][1]}, $Coro::current;
51 Coro::schedule; 80 &Coro::schedule;
52 } 81 }
53 --$self->[0]; 82 --$_[0][0];
83}
84
85sub timed_down {
86 require Coro::Timer;
87 my $timeout = Coro::Timer::timeout($_[1]);
88
89 while ($_[0][0] <= 0) {
90 push @{$_[0][1]}, $Coro::current;
91 &Coro::schedule;
92 if ($timeout) {
93 # ugly as hell. slow, too, btw!
94 for (0..$#{$_[0][1]}) {
95 if ($_[0][1][$_] == $Coro::current) {
96 splice @{$_[0][1]}, $_, 1;
97 return;
98 }
99 }
100 die;
101 }
102 }
103
104 --$_[0][0];
105 return 1;
54} 106}
55 107
56=item $sem->up 108=item $sem->up
57 109
58Unlock the semaphore again. 110Unlock the semaphore again.
59 111
60=cut 112=cut
61 113
62sub up { 114sub up {
63 my $self = shift;
64 if (++$self->[0] > 0) { 115 if (++$_[0][0] > 0) {
65 (shift @{$self->[1]})->ready if @{$self->[1]}; 116 (shift @{$_[0][1]})->ready if @{$_[0][1]};
66 } 117 }
67} 118}
68 119
69=item $sem->try 120=item $sem->try
70 121
… …
72otherwise return false and leave the semaphore unchanged. 123otherwise return false and leave the semaphore unchanged.
73 124
74=cut 125=cut
75 126
76sub try { 127sub try {
77 my $self = shift;
78 if ($self->[0] > 0) { 128 if ($_[0][0] > 0) {
79 --$self->[0]; 129 --$_[0][0];
80 return 1; 130 return 1;
81 } else { 131 } else {
82 return 0; 132 return 0;
83 } 133 }
84} 134}
85 135
861; 136=item $sem->waiters
137
138In scalar context, returns the number of coroutines waiting for this
139semaphore.
140
141=cut
142
143sub waiters {
144 @{$_[0][1]};
145}
146
147=item $guard = $sem->guard
148
149This method calls C<down> and then creates a guard object. When the guard
150object is destroyed it automatically calls C<up>.
151
152=item $guard = $sem->timed_guard($timeout)
153
154Like C<guard>, but returns undef if semaphore couldn't be acquired within
155$timeout seconds, otherwise the guard object.
156
157=cut
158
159sub guard {
160 &down;
161 # double indirection because bless works on the referenced
162 # object, not (only) on the reference itself.
163 bless \\$_[0], Coro::Semaphore::guard::;
164}
165
166sub timed_guard {
167 &timed_down
168 ? bless \\$_[0], Coro::Semaphore::guard::
169 : ();
170}
171
172sub Coro::Semaphore::guard::DESTROY {
173 &up(${${$_[0]}});
174}
87 175
88=back 176=back
89 177
90=head1 AUTHOR 178=head1 AUTHOR
91 179
92 Marc Lehmann <pcg@goof.com> 180 Marc Lehmann <schmorp@schmorp.de>
93 http://www.goof.com/pcg/marc/ 181 http://home.schmorp.de/
94 182
95=cut 183=cut
96 184
1851
186

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines