--- Coro/Coro/Semaphore.pm 2001/09/24 01:36:20 1.21 +++ Coro/Coro/Semaphore.pm 2008/11/03 16:05:38 1.74 @@ -33,11 +33,11 @@ package Coro::Semaphore; -no warnings qw(uninitialized); +no warnings; use Coro (); -$VERSION = 0.5; +$VERSION = 4.803; =item new [inital count] @@ -52,21 +52,74 @@ bless [defined $_[1] ? $_[1] : 1], $_[0]; } +=item $sem->count + +Returns the current semaphore count. + +=cut + +sub count { + $_[0][0] +} + +=item $sem->adjust ($diff) + +Atomically adds the amount given to the current semaphore count. If the +count becomes positive, wakes up any waiters. Does not block if the count +becomes negative, however. + +=cut + +sub adjust { + # basically a weird copy of up + if (($_[0][0] += $_[1]) > 0) { + (shift @{$_[0][1]})->ready if @{$_[0][1]}; + } +} + =item $sem->down Decrement the counter, therefore "locking" the semaphore. This method waits until the semaphore is available if the counter is zero. +=item $status = $sem->timed_down ($timeout) + +Like C, but returns false if semaphore couldn't be acquired within +$timeout seconds, otherwise true. + =cut sub down { while ($_[0][0] <= 0) { push @{$_[0][1]}, $Coro::current; - Coro::schedule; + &Coro::schedule; } --$_[0][0]; } +sub timed_down { + require Coro::Timer; + my $timeout = Coro::Timer::timeout ($_[1]); + + while ($_[0][0] <= 0) { + push @{$_[0][1]}, $Coro::current; + &Coro::schedule; + if ($timeout) { + # ugly as hell. slow, too, btw! + for (0..$#{$_[0][1]}) { + if ($_[0][1][$_] == $Coro::current) { + splice @{$_[0][1]}, $_, 1; + return; + } + } + die; + } + } + + --$_[0][0]; + return 1; +} + =item $sem->up Unlock the semaphore again. @@ -111,27 +164,38 @@ This method calls C and then creates a guard object. When the guard object is destroyed it automatically calls C. +=item $guard = $sem->timed_guard ($timeout) + +Like C, but returns undef if semaphore couldn't be acquired within +$timeout seconds, otherwise the guard object. + =cut sub guard { &down; # double indirection because bless works on the referenced # object, not (only) on the reference itself. - bless \\$_[0], Coro::Semaphore::Guard::; + bless \\$_[0], Coro::Semaphore::guard::; } -sub Coro::Semaphore::Guard::DESTROY { - &up(${${$_[0]}}); +sub timed_guard { + &timed_down + ? bless \\$_[0], Coro::Semaphore::guard:: + : (); } -1; +sub Coro::Semaphore::guard::DESTROY { + &up(${${$_[0]}}); +} =back =head1 AUTHOR - Marc Lehmann - http://www.goof.com/pcg/marc/ + Marc Lehmann + http://home.schmorp.de/ =cut +1 +