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.21 by root, Mon Sep 24 01:36:20 2001 UTC vs.
Revision 1.56 by root, Wed Jul 25 14:22:33 2007 UTC

… …
31 31
32=cut 32=cut
33 33
34package Coro::Semaphore; 34package Coro::Semaphore;
35 35
36no warnings qw(uninitialized); 36BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
37 37
38use Coro (); 38use Coro ();
39 39
40$VERSION = 0.5; 40$VERSION = 1.9;
41 41
42=item new [inital count] 42=item new [inital count]
43 43
44Creates a new sempahore object with the given initial lock count. The 44Creates a new sempahore object with the given initial lock count. The
45default lock count is 1, which means it is unlocked by default. Zero (or 45default lock count is 1, which means it is unlocked by default. Zero (or
… …
50 50
51sub new { 51sub new {
52 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52 bless [defined $_[1] ? $_[1] : 1], $_[0];
53} 53}
54 54
55=item $sem->count
56
57Returns the current semaphore count.
58
59=cut
60
61sub count {
62 $_[0][0]
63}
64
65=item $sem->adjust ($diff)
66
67Atomically adds the amount given to the current semaphore count. If the
68count becomes positive, wakes up any waiters. Does not block if the count
69becomes negative, however.
70
71=cut
72
73sub adjust {
74 # basically a weird copy of up
75 if (($_[0][0] += $_[1]) > 0) {
76 (shift @{$_[0][1]})->ready if @{$_[0][1]};
77 }
78}
79
55=item $sem->down 80=item $sem->down
56 81
57Decrement the counter, therefore "locking" the semaphore. This method 82Decrement the counter, therefore "locking" the semaphore. This method
58waits until the semaphore is available if the counter is zero. 83waits until the semaphore is available if the counter is zero.
84
85=item $status = $sem->timed_down($timeout)
86
87Like C<down>, but returns false if semaphore couldn't be acquired within
88$timeout seconds, otherwise true.
59 89
60=cut 90=cut
61 91
62sub down { 92sub down {
63 while ($_[0][0] <= 0) { 93 while ($_[0][0] <= 0) {
64 push @{$_[0][1]}, $Coro::current; 94 push @{$_[0][1]}, $Coro::current;
65 Coro::schedule; 95 &Coro::schedule;
66 } 96 }
67 --$_[0][0]; 97 --$_[0][0];
98}
99
100sub timed_down {
101 require Coro::Timer;
102 my $timeout = Coro::Timer::timeout($_[1]);
103
104 while ($_[0][0] <= 0) {
105 push @{$_[0][1]}, $Coro::current;
106 &Coro::schedule;
107 if ($timeout) {
108 # ugly as hell. slow, too, btw!
109 for (0..$#{$_[0][1]}) {
110 if ($_[0][1][$_] == $Coro::current) {
111 splice @{$_[0][1]}, $_, 1;
112 return;
113 }
114 }
115 die;
116 }
117 }
118
119 --$_[0][0];
120 return 1;
68} 121}
69 122
70=item $sem->up 123=item $sem->up
71 124
72Unlock the semaphore again. 125Unlock the semaphore again.
… …
109=item $guard = $sem->guard 162=item $guard = $sem->guard
110 163
111This method calls C<down> and then creates a guard object. When the guard 164This method calls C<down> and then creates a guard object. When the guard
112object is destroyed it automatically calls C<up>. 165object is destroyed it automatically calls C<up>.
113 166
167=item $guard = $sem->timed_guard($timeout)
168
169Like C<guard>, but returns undef if semaphore couldn't be acquired within
170$timeout seconds, otherwise the guard object.
171
114=cut 172=cut
115 173
116sub guard { 174sub guard {
117 &down; 175 &down;
118 # double indirection because bless works on the referenced 176 # double indirection because bless works on the referenced
119 # object, not (only) on the reference itself. 177 # object, not (only) on the reference itself.
120 bless \\$_[0], Coro::Semaphore::Guard::; 178 bless \\$_[0], Coro::Semaphore::guard::;
121} 179}
122 180
181sub timed_guard {
182 &timed_down
183 ? bless \\$_[0], Coro::Semaphore::guard::
184 : ();
185}
186
123sub Coro::Semaphore::Guard::DESTROY { 187sub Coro::Semaphore::guard::DESTROY {
124 &up(${${$_[0]}}); 188 &up(${${$_[0]}});
125} 189}
126 190
1271;
128
129=back 191=back
130 192
131=head1 AUTHOR 193=head1 AUTHOR
132 194
133 Marc Lehmann <pcg@goof.com> 195 Marc Lehmann <schmorp@schmorp.de>
134 http://www.goof.com/pcg/marc/ 196 http://home.schmorp.de/
135 197
136=cut 198=cut
137 199
2001
201

Diff Legend

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