example2.pl

   1 #!/usr/bin/perl
   2 #
   3 # example2.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 and queue them up.
   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 $max_queue);
  18
  19 # Semaphore pathname for key generation (will be created if missing)
  20 $sem_path_name = '/tmp/sem_test_b0c2';
  21 # Max concurrency - also used as semaphore proj_id
  22 $sem_max = 1;
  23 # Max number of queued processes (-1 eq infinite)
  24 $max_queue = 1;
  25
  26 my $sem = IPC::Semaphore::Concurrency->new(
  27         path     => $sem_path_name,
  28         project  => $sem_max,
  29         value    => $sem_max,
  30         ) or die("Failed to create semaphore: $!");
  31 if (@ARGV > 0 && $ARGV[0] eq 'reset') {
  32         $sem->remove();
  33         exit;
  34 }
  35
  36 print "\nbegin val: ".$sem->getval(0)."\n";
  37
  38 if ((my $res = $sem->acquire(
  39                         sem  => 0,
  40                         wait => 1,
  41                         max  => $max_queue,
  42                         undo => 1,
  43                         ))) {
  44         print "Do work\n";
  45         sleep 10;
  46 } elsif ($!{EWOULDBLOCK}) {
  47         print "Too many jobs queued up ($max_queue)!\n";
  48 } else {
  49         die("Unexpected Error: $!");
  50 }
  51
  52 print "\nend val: ".$sem->getval(0)."\n"; # Value will be re-incremented as soon as the process exits
  53