ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/SemaphoreSet.pm
(Generate patch)

Comparing Coro/Coro/SemaphoreSet.pm (file contents):
Revision 1.4 by root, Mon Sep 24 00:51:19 2001 UTC vs.
Revision 1.51 by root, Fri May 30 21:34:52 2008 UTC

… …
32 32
33no warnings; 33no warnings;
34 34
35use Coro (); 35use Coro ();
36 36
37$VERSION = 0.5; 37$VERSION = 4.741;
38 38
39=item new [inital count] 39=item new [inital count]
40 40
41Creates a new sempahore set with the given initial lock count for each 41Creates a new semaphore set with the given initial lock count for each
42individual semaphore. See L<Coro::Semaphore>. 42individual semaphore. See L<Coro::Semaphore>.
43 43
44=cut 44=cut
45 45
46sub new { 46sub new {
47 bless [defined $_[1] ? $_[1] : 1], $_[0]; 47 bless [defined $_[1] ? $_[1] : 1], $_[0];
48} 48}
49 49
50=item $sem->down($id) 50=item $sem->down ($id)
51 51
52Decrement the counter, therefore "locking" the named semaphore. This 52Decrement the counter, therefore "locking" the named semaphore. This
53method waits until the semaphore is available if the counter is zero. 53method waits until the semaphore is available if the counter is zero.
54 54
55=item $status = $sem->timed_down ($id, $timeout)
56
57Like C<down>, but returns false if semaphore couldn't be acquired within
58$timeout seconds, otherwise true.
59
55=cut 60=cut
56 61
57sub down { 62sub down {
63 while () {
58 my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]); 64 my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);
65
59 while ($sem->[0] <= 0) { 66 if ($sem->[0] > 0) {
67 --$sem->[0];
68 return 1;
69 }
70
60 push @{$sem->[1]}, $Coro::current; 71 push @{$sem->[1]}, $Coro::current;
61 Coro::schedule; 72 &Coro::schedule;
62 } 73 }
63 --$sem->[0];
64} 74}
65 75
76sub timed_down {
77 require Coro::Timer;
78 my $timeout = Coro::Timer::timeout ($_[2]);
79
80 while () {
81 my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);
82
83 if ($sem->[0] > 0) {
84 --$sem->[0];
85 return 1;
86 }
87
88 if ($timeout) {
89 # ugly as hell.
90 for (0..$#{$sem->[1]}) {
91 if ($sem->[1][$_] == $Coro::current) {
92 splice @{$sem->[1]}, $_, 1;
93 return 0;
94 }
95 }
96 die;
97 }
98
99 push @{$sem->[1]}, $Coro::current;
100 &Coro::schedule;
101 }
102}
103
66=item $sem->up($id) 104=item $sem->up ($id)
67 105
68Unlock the semaphore again. 106Unlock the semaphore again.
69 107
70=cut 108=cut
71 109
72sub up { 110sub up {
73 my $sem = $_[0][1]{$_[1]}; 111 my $sem = $_[0][1]{$_[1]};
112
74 if (++$sem->[0] > 0) { 113 if (++$sem->[0] > 0) {
75 (shift @{$sem->[1]})->ready if @{$sem->[1]}; 114 (shift @{$sem->[1]})->ready if @{$sem->[1]};
76 } 115 }
116
77 delete $_[0][1]{$_[1]} if $sem->[0] == $_[0][0]; 117 delete $_[0][1]{$_[1]} if $sem->[0] == $_[0][0] && !@{$sem->[1] || []};
78} 118}
79 119
80=item $sem->try 120=item $sem->try
81 121
82Try to C<down> the semaphore. Returns true when this was possible, 122Try to C<down> the semaphore. Returns true when this was possible,
… …
92 } else { 132 } else {
93 return 0; 133 return 0;
94 } 134 }
95} 135}
96 136
97=item $sem->waiters($id) 137=item $sem->waiters ($id)
98 138
99In scalar context, returns the number of coroutines waiting for this 139In scalar context, returns the number of coroutines waiting for this
100semaphore. 140semaphore.
101 141
102=cut 142=cut
103 143
104sub waiters { 144sub waiters {
145 my $sem = $_[0][1]{$_[1]}
146 or return;
105 @{$_[0][1]{$_[1]}}; 147 @{ $_[0][1]{$_[1]}[1] || []}
106} 148}
107 149
108=item $guard = $sem->guard($id) 150=item $guard = $sem->guard ($id)
109 151
110This method calls C<down> and then creates a guard object. When the guard 152This method calls C<down> and then creates a guard object. When the guard
111object is destroyed it automatically calls C<up>. 153object is destroyed it automatically calls C<up>.
154
155=item $guard = $sem->timed_guard ($id, $timeout)
156
157Like C<guard>, but returns undef if semaphore couldn't be acquired within
158$timeout seconds, otherwise the guard object.
112 159
113=cut 160=cut
114 161
115sub guard { 162sub guard {
116 &down; 163 &down;
117 # double indirection because bless works on the referenced
118 # object, not (only) on the reference itself.
119 bless [@_], Coro::SemaphoreSet::Guard::; 164 bless [@_], Coro::SemaphoreSet::guard::;
120} 165}
121 166
167sub timed_guard {
168 &timed_down
169 ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
170 : ();
171}
172
122sub Coro::SemaphoreSet::Guard::DESTROY { 173sub Coro::SemaphoreSet::guard::DESTROY {
123 &up(@{$_[0]}); 174 &up(@{$_[0]});
124} 175}
125 176
1261; 1771;
127 178
128=back 179=back
129 180
130=head1 AUTHOR 181=head1 AUTHOR
131 182
132 Marc Lehmann <pcg@goof.com> 183 Marc Lehmann <schmorp@schmorp.de>
133 http://www.goof.com/pcg/marc/ 184 http://home.schmorp.de/
134 185
135=cut 186=cut
136 187

Diff Legend

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