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.46 by root, Tue Aug 30 21:32:17 2005 UTC vs.
Revision 1.93 by root, Tue Jun 23 00:56:14 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro::Semaphore - non-binary semaphores 3Coro::Semaphore - counting semaphores
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Coro::Semaphore; 7 use Coro::Semaphore;
8 8
… …
31 31
32=cut 32=cut
33 33
34package Coro::Semaphore; 34package Coro::Semaphore;
35 35
36BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") } 36no warnings;
37 37
38use Coro (); 38use Coro ();
39 39
40$VERSION = 1.31; 40$VERSION = 5.132;
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
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 49=item $sem->count
50 50
51sub new { 51Returns the current semaphore count.
52 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52
53} 53=item $sem->adjust ($diff)
54
55Atomically adds the amount given to the current semaphore count. If the
56count becomes positive, wakes up any waiters. Does not block if the count
57becomes negative, however.
54 58
55=item $sem->down 59=item $sem->down
56 60
57Decrement the counter, therefore "locking" the semaphore. This method 61Decrement the counter, therefore "locking" the semaphore. This method
58waits until the semaphore is available if the counter is zero. 62waits until the semaphore is available if the counter is zero.
59 63
60=item $status = $sem->timed_down($timeout) 64=item $sem->wait
61 65
62Like C<down>, but returns false if semaphore couldn't be acquired within 66Similar to C<down>, but does not actually decrement the counter. Instead,
63$timeout seconds, otherwise true. 67when this function returns, a following call to C<down> or C<try> is
68guaranteed to succeed without blocking, until the next coroutine switch
69(C<cede> etc.).
70
71Note that using C<wait> is much less efficient than using C<down>, so try
72to prefer C<down> whenever possible.
73
74=item $sem->wait ($callback)
75
76If you pass a callback argument to C<wait>, it will not wait, but
77immediately return. The callback will be called as soon as the semaphore
78becomes available (which might be instantly), and gets passed the
79semaphore as first argument.
80
81The callback might C<down> the semaphore exactly once, might wake up other
82coroutines, but is I<NOT> allowed to block (switch to other coroutines).
64 83
65=cut 84=cut
66 85
67sub down { 86#=item $status = $sem->timed_down ($timeout)
68 while ($_[0][0] <= 0) { 87#
69 push @{$_[0][1]}, $Coro::current; 88#Like C<down>, but returns false if semaphore couldn't be acquired within
70 Coro::schedule; 89#$timeout seconds, otherwise true.
71 }
72 --$_[0][0];
73}
74 90
75sub timed_down { 91#sub timed_down {
76 require Coro::Timer; 92# require Coro::Timer;
77 my $timeout = Coro::Timer::timeout($_[1]); 93# my $timeout = Coro::Timer::timeout ($_[1]);
78 94#
79 while ($_[0][0] <= 0) { 95# while ($_[0][0] <= 0) {
80 push @{$_[0][1]}, $Coro::current; 96# push @{$_[0][1]}, $Coro::current;
81 Coro::schedule; 97# &Coro::schedule;
82 if ($timeout) { 98# if ($timeout) {
83 # ugly as hell. slow, too, btw! 99# # ugly as hell. slow, too, btw!
84 for (0..$#{$_[0][1]}) { 100# for (0..$#{$_[0][1]}) {
85 if ($_[0][1][$_] == $Coro::current) { 101# if ($_[0][1][$_] == $Coro::current) {
86 splice @{$_[0][1]}, $_, 1; 102# splice @{$_[0][1]}, $_, 1;
87 return; 103# return;
88 } 104# }
89 } 105# }
90 die; 106# die;
91 } 107# }
92 } 108# }
93 109#
94 --$_[0][0]; 110# --$_[0][0];
95 return 1; 111# return 1;
96} 112#}
97 113
98=item $sem->up 114=item $sem->up
99 115
100Unlock the semaphore again. 116Unlock the semaphore again.
101
102=cut
103
104sub up {
105 if (++$_[0][0] > 0) {
106 (shift @{$_[0][1]})->ready if @{$_[0][1]};
107 }
108}
109 117
110=item $sem->try 118=item $sem->try
111 119
112Try to C<down> the semaphore. Returns true when this was possible, 120Try to C<down> the semaphore. Returns true when this was possible,
113otherwise return false and leave the semaphore unchanged. 121otherwise return false and leave the semaphore unchanged.
114 122
115=cut
116
117sub try {
118 if ($_[0][0] > 0) {
119 --$_[0][0];
120 return 1;
121 } else {
122 return 0;
123 }
124}
125
126=item $sem->waiters 123=item $sem->waiters
127 124
128In scalar context, returns the number of coroutines waiting for this 125In scalar context, returns the number of coroutines waiting for this
129semaphore. 126semaphore.
130
131=cut
132
133sub waiters {
134 @{$_[0][1]};
135}
136 127
137=item $guard = $sem->guard 128=item $guard = $sem->guard
138 129
139This method calls C<down> and then creates a guard object. When the guard 130This method calls C<down> and then creates a guard object. When the guard
140object is destroyed it automatically calls C<up>. 131object is destroyed it automatically calls C<up>.
141 132
142=item $guard = $sem->timed_guard($timeout)
143
144Like C<guard>, but returns undef if semaphore couldn't be acquired within
145$timeout seconds, otherwise the guard object.
146
147=cut 133=cut
148 134
149sub guard { 135sub guard {
150 &down; 136 &down;
151 # double indirection because bless works on the referenced
152 # object, not (only) on the reference itself.
153 bless \\$_[0], Coro::Semaphore::guard::; 137 bless [$_[0]], Coro::Semaphore::guard::
154} 138}
155 139
140#=item $guard = $sem->timed_guard ($timeout)
141#
142#Like C<guard>, but returns undef if semaphore couldn't be acquired within
143#$timeout seconds, otherwise the guard object.
144
156sub timed_guard { 145#sub timed_guard {
157 &timed_down 146# &timed_down
158 ? bless \\$_[0], Coro::Semaphore::guard:: 147# ? bless \\$_[0], Coro::Semaphore::guard::
159 : (); 148# : ();
160} 149#}
161 150
162sub Coro::Semaphore::guard::DESTROY { 151sub Coro::Semaphore::guard::DESTROY {
163 &up(${${$_[0]}}); 152 &up($_[0][0]);
164} 153}
165
1661;
167 154
168=back 155=back
169 156
170=head1 AUTHOR 157=head1 AUTHOR
171 158
172 Marc Lehmann <schmorp@schmorp.de> 159 Marc Lehmann <schmorp@schmorp.de>
173 http://home.schmorp.de/ 160 http://home.schmorp.de/
174 161
175=cut 162=cut
176 163
1641
165

Diff Legend

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