X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FThread%2FSemaphore.pm;h=1e7fcff3ffb198326f22d18299b414dac50158c4;hb=ac9d3a9d44cf24ffa50574d1a7d6c147fd438c5f;hp=1e188542de8d0312cce39073a4213d874fc647f1;hpb=2af1ab88da52f38a7450a6455bc28aa93c8e4e57;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Thread/Semaphore.pm b/lib/Thread/Semaphore.pm index 1e18854..1e7fcff 100644 --- a/lib/Thread/Semaphore.pm +++ b/lib/Thread/Semaphore.pm @@ -1,97 +1,159 @@ package Thread::Semaphore; +use strict; +use warnings; + +our $VERSION = '2.07'; + use threads::shared; +use Scalar::Util 1.10 qw(looks_like_number); + +# Create a new semaphore optionally with specified count (count defaults to 1) +sub new { + my $class = shift; + my $val :shared = @_ ? shift : 1; + if (! looks_like_number($val) || (int($val) != $val)) { + require Carp; + $val = 'undef' if (! defined($val)); + Carp::croak("Semaphore initializer is not an integer: $val"); + } + return bless(\$val, $class); +} -our $VERSION = '2.01'; +# Decrement a semaphore's count (decrement amount defaults to 1) +sub down { + my $sema = shift; + lock($$sema); + my $dec = @_ ? shift : 1; + if (! looks_like_number($dec) || (int($dec) != $dec) || ($dec < 1)) { + require Carp; + $dec = 'undef' if (! defined($dec)); + Carp::croak("Semaphore decrement is not a positive integer: $dec"); + } + cond_wait($$sema) until ($$sema >= $dec); + $$sema -= $dec; +} + +# Increment a semaphore's count (increment amount defaults to 1) +sub up { + my $sema = shift; + lock($$sema); + my $inc = @_ ? shift : 1; + if (! looks_like_number($inc) || (int($inc) != $inc) || ($inc < 1)) { + require Carp; + $inc = 'undef' if (! defined($inc)); + Carp::croak("Semaphore increment is not a positive integer: $inc"); + } + ($$sema += $inc) > 0 and cond_broadcast($$sema); +} + +1; =head1 NAME -Thread::Semaphore - thread-safe semaphores +Thread::Semaphore - Thread-safe semaphores + +=head1 VERSION + +This document describes Thread::Semaphore version 2.07 =head1 SYNOPSIS use Thread::Semaphore; - my $s = new Thread::Semaphore; - $s->down; # Also known as the semaphore P operation. + my $s = Thread::Semaphore->new(); + $s->down(); # Also known as the semaphore P operation. # The guarded section is here - $s->up; # Also known as the semaphore V operation. + $s->up(); # Also known as the semaphore V operation. - # The default semaphore value is 1. - my $s = new Thread::Semaphore($initial_value); + # The default semaphore value is 1 + my $s = Thread::Semaphore-new($initial_value); $s->down($down_value); $s->up($up_value); =head1 DESCRIPTION -Semaphores provide a mechanism to regulate access to resources. Semaphores, -unlike locks, aren't tied to particular scalars, and so may be used to +Semaphores provide a mechanism to regulate access to resources. Unlike +locks, semaphores aren't tied to particular scalars, and so may be used to control access to anything you care to use them for. -Semaphores don't limit their values to zero or one, so they can be used to -control access to some resource that there may be more than one of. (For -example, filehandles.) Increment and decrement amounts aren't fixed at one -either, so threads can reserve or return multiple resources at once. +Semaphores don't limit their values to zero and one, so they can be used to +control access to some resource that there may be more than one of (e.g., +filehandles). Increment and decrement amounts aren't fixed at one either, +so threads can reserve or return multiple resources at once. -=head1 FUNCTIONS AND METHODS +=head1 METHODS =over 8 -=item new +=item ->new() + +=item ->new(NUMBER) -=item new NUMBER +C creates a new semaphore, and initializes its count to the specified +number (which must be an integer). If no number is specified, the +semaphore's count defaults to 1. -C creates a new semaphore, and initializes its count to the passed -number. If no number is passed, the semaphore's count is set to one. +=item ->down() -=item down +=item ->down(NUMBER) -=item down NUMBER +The C method decreases the semaphore's count by the specified number +(which must be an integer >= 1), or by one if no number is specified. -The C method decreases the semaphore's count by the specified number, -or by one if no number has been specified. If the semaphore's count would drop -below zero, this method will block until such time that the semaphore's -count is equal to or larger than the amount you're Cing the -semaphore's count by. +If the semaphore's count would drop below zero, this method will block +until such time as the semaphore's count is greater than or equal to the +amount you're Cing the semaphore's count by. This is the semaphore "P operation" (the name derives from the Dutch word "pak", which means "capture" -- the semaphore operations were named by the late Dijkstra, who was Dutch). -=item up +=item ->up() -=item up NUMBER +=item ->up(NUMBER) -The C method increases the semaphore's count by the number specified, -or by one if no number has been specified. This will unblock any thread blocked -trying to C the semaphore if the C raises the semaphore count -above the amount that the Cs are trying to decrement it by. +The C method increases the semaphore's count by the number specified +(which must be an integer >= 1), or by one if no number is specified. + +This will unblock any thread that is blocked trying to C the +semaphore if the C raises the semaphore's count above the amount that +the C is trying to decrement it by. For example, if three threads +are blocked trying to C a semaphore by one, and another thread Cs +the semaphore by two, then two of the blocked threads (which two is +indeterminate) will become unblocked. This is the semaphore "V operation" (the name derives from the Dutch word "vrij", which means "release"). =back -=cut +=head1 NOTES -sub new { - my $class = shift; - my $val : shared = @_ ? shift : 1; - bless \$val, $class; -} +Semaphores created by L can be used in both threaded and +non-threaded applications. This allows you to write modules and packages +that potentially make use of semaphores, and that will function in either +environment. -sub down { - my $s = shift; - lock($$s); - my $inc = @_ ? shift : 1; - cond_wait $$s until $$s >= $inc; - $$s -= $inc; -} +=head1 SEE ALSO -sub up { - my $s = shift; - lock($$s); - my $inc = @_ ? shift : 1; - ($$s += $inc) > 0 and cond_broadcast $$s; -} +Thread::Semaphore Discussion Forum on CPAN: +L -1; +Annotated POD for Thread::Semaphore: +L + +Source repository: +L + +L, L + +=head1 MAINTAINER + +Jerry D. Hedden, Sjdhedden AT cpan DOT orgE> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut