example.pl

   1 #!/usr/bin/perl
   2 #
   3 # example.pl - Limiting process concurrency using IPC::Semaphore::Concurrency
   4 #
   5 # Author: Thomas Guyot-Sionnest <tguyot@gmail.com>
   6 #
   7 # This in a perl example of using semaphores to limit concurrent processes
   8 # doing a specific task.
   9 #
  10 # This code is released to the public domain.
  11 #
  12
  13 use strict;
  14 use warnings;
  15 use IPC::Semaphore::Concurrency;
  16 use Errno;
  17 use vars qw($sem_path_name $sem_max);
  18
  19 # Semaphore pathname for key generation (will be created if missing)
  20 $sem_path_name = '/tmp/sem_test_5a76';
  21 # Max concurrency - also used as semaphore proj_id
  22 $sem_max = 4;
  23
  24 my $sem = IPC::Semaphore::Concurrency->new(
  25         path    => $sem_path_name,
  26         project => $sem_max,
  27         value   => $sem_max,
  28         );
  29 if (@ARGV > 0 && $ARGV[0] eq 'reset') {
  30         $sem->remove();
  31         exit;
  32 }
  33
  34 print "begin val: ".$sem->getval(0)."\n";
  35 if ($sem->acquire(0, 0, 0, 1)) {
  36         print "Do work\n";
  37         sleep 10;
  38 } elsif ($!{EWOULDBLOCK}) {
  39         print "Pass your turn\n";
  40 } else {
  41         die("Unexpected Error: $!");
  42 }
  43
  44 print "end val: ".$sem->getval(0)."\n"; # Value will be re-incremented as soon as the process exits
  45