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.16 by root, Thu Aug 30 02:58:17 2001 UTC vs.
Revision 1.69 by root, Tue Sep 23 00:02:20 2008 UTC

… …
31 31
32=cut 32=cut
33 33
34package Coro::Semaphore; 34package Coro::Semaphore;
35 35
36no warnings;
37
36use Coro (); 38use Coro ();
37 39
38$VERSION = 0.45; 40$VERSION = 4.747;
39 41
40=item new [inital count] 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
… …
48 50
49sub new { 51sub new {
50 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52 bless [defined $_[1] ? $_[1] : 1], $_[0];
51} 53}
52 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
53=item $sem->down 80=item $sem->down
54 81
55Decrement the counter, therefore "locking" the semaphore. This method 82Decrement the counter, therefore "locking" the semaphore. This method
56waits until the semaphore is available if the counter is zero. 83waits until the semaphore is available if the counter is zero.
57 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.
89
58=cut 90=cut
59 91
60sub down { 92sub down {
61 my $self = shift;
62 while ($self->[0] <= 0) { 93 while ($_[0][0] <= 0) {
63 push @{$self->[1]}, $Coro::current; 94 push @{$_[0][1]}, $Coro::current;
64 Coro::schedule; 95 &Coro::schedule;
65 } 96 }
66 --$self->[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;
67} 121}
68 122
69=item $sem->up 123=item $sem->up
70 124
71Unlock the semaphore again. 125Unlock the semaphore again.
72 126
73=cut 127=cut
74 128
75sub up { 129sub up {
76 my $self = shift;
77 if (++$self->[0] > 0) { 130 if (++$_[0][0] > 0) {
78 (shift @{$self->[1]})->ready if @{$self->[1]}; 131 (shift @{$_[0][1]})->ready if @{$_[0][1]};
79 } 132 }
80} 133}
81 134
82=item $sem->try 135=item $sem->try
83 136
… …
85otherwise return false and leave the semaphore unchanged. 138otherwise return false and leave the semaphore unchanged.
86 139
87=cut 140=cut
88 141
89sub try { 142sub try {
90 my $self = shift;
91 if ($self->[0] > 0) { 143 if ($_[0][0] > 0) {
92 --$self->[0]; 144 --$_[0][0];
93 return 1; 145 return 1;
94 } else { 146 } else {
95 return 0; 147 return 0;
96 } 148 }
97} 149}
… …
109 161
110=item $guard = $sem->guard 162=item $guard = $sem->guard
111 163
112This 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
113object is destroyed it automatically calls C<up>. 165object 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.
114 171
115=cut 172=cut
116 173
117sub guard { 174sub guard {
118 &down; 175 &down;
119 # double indirection because bless works on the referenced 176 # double indirection because bless works on the referenced
120 # object, not (only) on the reference itself. 177 # object, not (only) on the reference itself.
121 bless \\$_[0], Coro::Semaphore::Guard::; 178 bless \\$_[0], Coro::Semaphore::guard::;
122} 179}
123 180
181sub timed_guard {
182 &timed_down
183 ? bless \\$_[0], Coro::Semaphore::guard::
184 : ();
185}
186
124sub Coro::Semaphore::Guard::DESTROY { 187sub Coro::Semaphore::guard::DESTROY {
125 &up(${${$_[0]}}); 188 &up(${${$_[0]}});
126} 189}
127 190
1281;
129
130=back 191=back
131 192
132=head1 AUTHOR 193=head1 AUTHOR
133 194
134 Marc Lehmann <pcg@goof.com> 195 Marc Lehmann <schmorp@schmorp.de>
135 http://www.goof.com/pcg/marc/ 196 http://home.schmorp.de/
136 197
137=cut 198=cut
138 199
2001
201

Diff Legend

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