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.79 by root, Fri Nov 14 02:42:26 2008 UTC vs.
Revision 1.80 by root, Sat Nov 15 06:26:52 2008 UTC

… …
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
46negative values) are also allowed, in which case the semaphore is locked 46negative values) are also allowed, in which case the semaphore is locked
47by default. 47by default.
48 48
49=cut
50
51sub new {
52 bless [defined $_[1] ? $_[1] : 1], $_[0];
53}
54
55=item $sem->count 49=item $sem->count
56 50
57Returns the current semaphore count. 51Returns the current semaphore count.
58
59=cut
60
61sub count {
62 $_[0][0]
63}
64 52
65=item $sem->adjust ($diff) 53=item $sem->adjust ($diff)
66 54
67Atomically adds the amount given to the current semaphore count. If the 55Atomically adds the amount given to the current semaphore count. If the
68count becomes positive, wakes up any waiters. Does not block if the count 56count becomes positive, wakes up any waiters. Does not block if the count
69becomes negative, however. 57becomes negative, however.
70 58
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
80=item $sem->down 59=item $sem->down
81 60
82Decrement the counter, therefore "locking" the semaphore. This method 61Decrement the counter, therefore "locking" the semaphore. This method
83waits until the semaphore is available if the counter is zero. 62waits until the semaphore is available if the counter is zero.
84 63
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.
89
90=cut 64=cut
91 65
92sub down { 66#=item $status = $sem->timed_down ($timeout)
93 while ($_[0][0] <= 0) { 67#
94 push @{$_[0][1]}, $Coro::current; 68#Like C<down>, but returns false if semaphore couldn't be acquired within
95 &Coro::schedule; 69#$timeout seconds, otherwise true.
96 }
97 --$_[0][0];
98}
99 70
100sub timed_down { 71#sub timed_down {
101 require Coro::Timer; 72# require Coro::Timer;
102 my $timeout = Coro::Timer::timeout ($_[1]); 73# my $timeout = Coro::Timer::timeout ($_[1]);
103 74#
104 while ($_[0][0] <= 0) { 75# while ($_[0][0] <= 0) {
105 push @{$_[0][1]}, $Coro::current; 76# push @{$_[0][1]}, $Coro::current;
106 &Coro::schedule; 77# &Coro::schedule;
107 if ($timeout) { 78# if ($timeout) {
108 # ugly as hell. slow, too, btw! 79# # ugly as hell. slow, too, btw!
109 for (0..$#{$_[0][1]}) { 80# for (0..$#{$_[0][1]}) {
110 if ($_[0][1][$_] == $Coro::current) { 81# if ($_[0][1][$_] == $Coro::current) {
111 splice @{$_[0][1]}, $_, 1; 82# splice @{$_[0][1]}, $_, 1;
112 return; 83# return;
113 } 84# }
114 } 85# }
115 die; 86# die;
116 } 87# }
117 } 88# }
118 89#
119 --$_[0][0]; 90# --$_[0][0];
120 return 1; 91# return 1;
121} 92#}
122 93
123=item $sem->up 94=item $sem->up
124 95
125Unlock the semaphore again. 96Unlock the semaphore again.
126
127=cut
128
129sub up {
130 if (++$_[0][0] > 0) {
131 (shift @{$_[0][1]})->ready if @{$_[0][1]};
132 }
133}
134 97
135=item $sem->try 98=item $sem->try
136 99
137Try to C<down> the semaphore. Returns true when this was possible, 100Try to C<down> the semaphore. Returns true when this was possible,
138otherwise return false and leave the semaphore unchanged. 101otherwise return false and leave the semaphore unchanged.
139 102
140=cut
141
142sub try {
143 if ($_[0][0] > 0) {
144 --$_[0][0];
145 return 1;
146 } else {
147 return 0;
148 }
149}
150
151=item $sem->waiters 103=item $sem->waiters
152 104
153In scalar context, returns the number of coroutines waiting for this 105In scalar context, returns the number of coroutines waiting for this
154semaphore. 106semaphore.
155 107
156=cut
157
158sub waiters {
159 @{$_[0][1]};
160}
161
162=item $guard = $sem->guard 108=item $guard = $sem->guard
163 109
164This method calls C<down> and then creates a guard object. When the guard 110This method calls C<down> and then creates a guard object. When the guard
165object is destroyed it automatically calls C<up>. 111object is destroyed it automatically calls C<up>.
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 112
172=cut 113=cut
173 114
174sub guard { 115sub guard {
175 &down; 116 &down;
176 # double indirection because bless works on the referenced 117 # double indirection because bless works on the referenced
177 # object, not (only) on the reference itself. 118 # object, not (only) on the reference itself.
178 bless \\$_[0], Coro::Semaphore::guard::; 119 bless \\$_[0], Coro::Semaphore::guard::;
179} 120}
180 121
122#=item $guard = $sem->timed_guard ($timeout)
123#
124#Like C<guard>, but returns undef if semaphore couldn't be acquired within
125#$timeout seconds, otherwise the guard object.
126
181sub timed_guard { 127#sub timed_guard {
182 &timed_down 128# &timed_down
183 ? bless \\$_[0], Coro::Semaphore::guard:: 129# ? bless \\$_[0], Coro::Semaphore::guard::
184 : (); 130# : ();
185} 131#}
186 132
187sub Coro::Semaphore::guard::DESTROY { 133sub Coro::Semaphore::guard::DESTROY {
188 &up(${${$_[0]}}); 134 &up(${${$_[0]}});
189} 135}
190 136

Diff Legend

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