Thread::Barrier - thread execution barrier

  use Thread::Barrier;

  my $br = Thread::Barrier->new($thr_cnt);

  $br->wait; 

  if ($br->wait) }
      # executed by only one released thread
      ...
  }

    sub worker {            # Thr routine: threads->create(\&worker, ...)
        my $br = shift;     # $br->isa('Thread::Barrier')

        get_ready();

        if ($br->wait) {
            do_log("All ready");    # Called only once
        }

       do_work();
    }

    sub worker {
        my $br = shift;

        get_ready();

        if ($br->wait) {
            init_globals();     # Must run after all get_ready() 
                                # calls complete
        }

        $br->wait;              # Prevents do_work() from running
                                # before init_globals() finishes.
        do_work();
    }

###########################################################################
# $Id: Barrier.pm,v 1.9 2007/03/25 08:20:07 wendigo Exp $
###########################################################################
#
# Barrier.pm
#
# RCS Revision: $Revision: 1.9 $
# Date: $Date: 2007/03/25 08:20:07 $
#
# Copyright 2002-2003, 2005, 2007 Mark Rogaski, mrogaski@cpan.org
#
# See the README file included with the
# distribution for license information.
#
###########################################################################

package Thread::Barrier;

use 5.008;
use strict;
use warnings;

use threads;
use threads::shared;

our $VERSION = '0.300';

###########################################################################
# Public Methods
###########################################################################

#
# new - creates a new Thread::Barrier object
#
# Arguments:
#
# threshold (opt)
#   Specifies the required number of threads that 
#   must block on the barrier before it is released.
#   Default value is 0.
# 
# Returns a Thread::Barrier object on success, dies on failure.
#
sub new {
    my $class       = shift;

    my $self = &share({});
    bless $self, $class;

    %$self = (
        threshold   => 0, # threads required to release barrier
        count       => 0, # number of threads blocking on barrier
        generation  => 0, # incremented when barrier is released
    );

    $self->set_threshold(shift) if @_; # may die

    return $self;
}


#
# init - set the threshold value for the barrier
#
# *** DEPRECATED ***
#
# Arguments:
#
# threshold
#   Specifies the required number of threads that 
#   must block on the barrier before it is released.
# 
# Returns the passed argument.
#
sub init {
    my($self, $threshold) = @_;
    $self->set_threshold($threshold);
    return $threshold;
}


#
# wait - block until a sufficient number of threads have reached the barrier
#
# Arguments:
#
# none
#
# Returns true to one of threads released upon barrier reset, false to 
# all others.
#
sub wait {
    my $self = shift;
    lock $self;

    $self->{count}++;

    return 1 if $self->_try_release; # barrier reset and released

    # otherwise block
    my $gen = $self->{generation};
    cond_wait($self) while $self->{generation} == $gen;

    return;
}


#
# set_threshold - adjust the barrier's threshold, possibly releasing it
#                  if enough threads are blocking.
#
# Arguments:
#
# threshold
#   Specifies the required number of threads that 
#   must block on the barrier before it is released.
# 
# Returns true if barrier is released, false otherwise.
#
sub set_threshold {
    my($self, $threshold) = @_;
    my $err;

    # validate threshold
    for ($threshold) {
        $err = "no argument supplied", last unless defined $_;
        $err = "invalid argument supplied", last if /[^0-9]/;
    }
    if ($err) {
        require Carp;
        $Carp::CarpLevel = 1;
        Carp::confess($err);
    }

    # apply new threshold, possibly releasing barrier
    lock $self;
    $self->{threshold} = $threshold;

    # check for release condition
    $self->_try_release;
}


#
# threshold - accessor for debugging purposes
#
sub threshold {
    my $self = shift;
    lock $self;
    return $self->{threshold};
}


#
# count - accessor for debugging purposes
#
sub count {
    my $self = shift;
    lock $self;
    return $self->{count};
}


###########################################################################
# Private Methods
###########################################################################

#
# _tr_release - release the barrier if a sufficient number of threads
#               have reached the barrier.
#
# Arguments:
#
#   none
# 
# Returns true if barrier is released, false otherwise.
#
sub _try_release {
    my $self = shift;
    lock $self;

    return undef if $self->{count} < $self->{threshold};

    # reset barrier and release
    $self->{generation}++;
    $self->{count} = 0;
    cond_broadcast($self);
    return 1;
}


1;
__END__