Pots::Semaphore - Perl ObjectThreads shared thread safe semaphore class

Pots documentation Contained in the Pots distribution.

Index

Code Index:

NAME

Top

Pots::Semaphore - Perl ObjectThreads shared thread safe semaphore class

SYNOPSIS

Top

    use threads;

    use Pots::Semaphore;

    my $s = Pots::Semaphore->new(0);

    sub thread_proc {
        print "Thread waiting for semaphore.\n";
        $s->down();
        print "Thread got semaphore.\n";
    }

    my $th = threads->new("thread_proc");
    sleep(5);

    $s->up();

DESCRIPTION

Top

This class is a direct revamp of the standard Perl Thread::Semaphore. It only exists because, for a yet unknown reason, I was unable to store standard Thread::Semaphore objects in shared accessors. Once this is worked out, this class will surely disappear.

METHODS

Top

See Thread::Semaphore.

AUTHOR and COPYRIGHT

Top

Remy Chibois <rchibois at free.fr>

Copyright (c) 2004 Remy Chibois. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Pots documentation Contained in the Pots distribution. 
##########################################################################
#
# Module template
#
##########################################################################
package Pots::Semaphore;

##########################################################################
#
# Modules
#
##########################################################################
use threads;
use threads::shared;

use strict;
use warnings;

##########################################################################
#
# Global variables
#
##########################################################################

##########################################################################
#
# Private methods
#
##########################################################################

##########################################################################
#
# Public methods
#
##########################################################################
sub new {
    my $class = shift;
    my $val : shared = @_ ? shift : 1;

    my %hself : shared = ();
    my $self = bless (\%hself, ref ($class) || $class);

    lock(%{$self});

    $self->{_sem} = \$val;

    return $self;
}

sub down {
    my $self = shift;

    my $ref = $self->{_sem};
    lock($$ref);

    my $inc = @_ ? shift : 1;
    cond_wait $$ref until $$ref >= $inc;
    $$ref -= $inc;
}

sub up {
    my $self = shift;

    my $ref = $self->{_sem};
    lock($$ref);

    my $inc = @_ ? shift : 1;
    ($$ref += $inc) > 0 and cond_broadcast $$ref;
}

1; #this line is important and will help the module return a true value
__END__