X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FThread%2FSemaphore.pm;h=67cb30e66a6c9b957ce3b6dfe2468af6d45ebeb1;hb=e63b33793c3cf76a134a6446d1f83479e030a15f;hp=51cc0c6fef0bd2b5f8963d8a06f1111a55cf36c3;hpb=3d1f1caf68f964a756e1ffb5a4c6bc032cad2402;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Thread/Semaphore.pm b/lib/Thread/Semaphore.pm index 51cc0c6..67cb30e 100644 --- a/lib/Thread/Semaphore.pm +++ b/lib/Thread/Semaphore.pm @@ -1,120 +1,170 @@ package Thread::Semaphore; use strict; +use warnings; -our $VERSION = '1.00'; - -use Thread qw(cond_wait cond_broadcast); - -BEGIN { - use Config; - if ($Config{useithreads}) { - require 'threads/shared/semaphore.pm'; - for my $meth (qw(new up down)) { - no strict 'refs'; - *{"Thread::Semaphore::$meth"} = \&{"threads::shared::semaphore::$meth"}; - } - } elsif ($Config{use5005threads}) { - for my $meth (qw(new up down)) { - no strict 'refs'; - *{"Thread::Semaphore::$meth"} = \&{"Thread::Semaphore::${meth}_othread"}; - } - } else { +our $VERSION = '2.09'; + +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 (!defined($val) || + ! looks_like_number($val) || + (int($val) != $val)) + { require Carp; - Carp::croak("This Perl has neither ithreads nor 5005threads"); + $val = 'undef' if (! defined($val)); + Carp::croak("Semaphore initializer is not an integer: $val"); } + return bless(\$val, $class); } +# Decrement a semaphore's count (decrement amount defaults to 1) +sub down { + my $sema = shift; + lock($$sema); + my $dec = @_ ? shift : 1; + if (! defined($dec) || + ! 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; +} -=head1 NAME +# Increment a semaphore's count (increment amount defaults to 1) +sub up { + my $sema = shift; + lock($$sema); + my $inc = @_ ? shift : 1; + if (! defined($inc) || + ! 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; -Thread::Semaphore - thread-safe semaphores (for old code only) +=head1 NAME -=head1 CAVEAT +Thread::Semaphore - Thread-safe semaphores -For new code the use of the C module is discouraged and -the direct use of the C, C and -C modules is encouraged instead. +=head1 VERSION -For the whole story about the development of threads in Perl, and why you -should B be using this module unless you know what you're doing, see the -CAVEAT of the C module. +This document describes Thread::Semaphore version 2.09 =head1 SYNOPSIS use Thread::Semaphore; - my $s = new Thread::Semaphore; - $s->up; # Also known as the semaphore V -operation. + my $s = Thread::Semaphore->new(); + $s->down(); # Also known as the semaphore P operation. # The guarded section is here - $s->down; # Also known as the semaphore P -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); - $s->down($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 may have 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) + +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. + +=item ->down() -=item new NUMBER +=item ->down(NUMBER) -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. +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. -=item down +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. -=item down NUMBER +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). -The C method decreases the semaphore's count by the specified number, -or 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. +=item ->up() -=item up +=item ->up(NUMBER) -=item up NUMBER +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. -The C method increases the semaphore's count by the number specified, -or one if no number's been specified. This will unblock any thread blocked -trying to C the semaphore if the C raises the semaphore count -above what the Cs are trying to decrement it by. +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_othread { - my $class = shift; - my $val = @_ ? 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_othread : locked : method { - my $s = shift; - my $inc = @_ ? shift : 1; - cond_wait $s until $$s >= $inc; - $$s -= $inc; -} +=head1 SEE ALSO -sub up_othread : locked : method { - my $s = shift; - 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