--- Coro/Coro/Semaphore.pm 2001/10/03 01:09:57 1.22 +++ Coro/Coro/Semaphore.pm 2006/01/25 21:43:58 1.52 @@ -33,11 +33,11 @@ package Coro::Semaphore; -no warnings qw(uninitialized); +BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") } use Coro (); -$VERSION = 0.51; +$VERSION = 1.8; =item new [inital count] @@ -57,6 +57,11 @@ 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 { @@ -67,6 +72,29 @@ --$_[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 +139,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 +