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.12 by root, Sat Jul 28 01:41:58 2001 UTC vs.
Revision 1.46 by root, Tue Aug 30 21:32:17 2005 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines