######################################################################
# Mutex.pm
######################################################################
# Perl Power! - Michael Schilli 1998
######################################################################

#!/usr/bin/perl -w

package Mutex;

use strict;

# Flags fŸr Semaphore

my $IPC_CREAT  = 0001000;   # create semaphore
my $IPC_EXCL   = 0002000;   # create fails if key exists
my $IPC_NOWAIT = 0004000;   # error if blocked

my $SEM_UNDO   = 0100000;   # release semaphore if
                            # process terminates
# semaphor commands

my $IPC_RMID   = 0000000;   # remove
my $IPC_SET    = 0000001;   # set
my $IPC_STAT   = 0000002;   # interrogate

######################################################################
sub new {
######################################################################
    my $class = shift;
    my $key   = shift;

    my $self = {};

    $self->{'semid'}  = semget($key, 1, 0644|$IPC_CREAT);

    die "Create failed" unless defined($self->{'semid'});

    bless($self, $class);
}

######################################################################
# Set semaphore lock: $sem->lock();
######################################################################
sub lock {
    my $self = shift;

    my $semnum  = 0;   # first semaphore of list
    my $semflag = 0;

    # wait until semaphore is zero
    my $semop     = 0;
    my $opstring1 = pack("sss", $semnum, $semop, $semflag);

    # increment semaphore counter by 1
    $semop     = $IPC_SET;
    $semflag   = $SEM_UNDO;  # release semaphore when
                             # process ends
    my $opstring2 = pack("sss", $semnum, $semop,  $semflag);

    semop($self->{'semid'}, $opstring1 . $opstring2) || 
                                       die "Lock failed";
}

######################################################################
# Release semaphore lock: $sem->release();
######################################################################
sub release {
    my $self = shift;

    my $semnum  = 0;   # first semaphore of list
    my $semflag = 0;

    # count down
    my $semop = -1;
    my $opstring = pack("sss", $semnum, $semop, $semflag);

    semop($self->{'semid'},$opstring) || 
                                die "Release failed";
}

######################################################################
# Delete semaphore: $sem->delete();
######################################################################
sub delete {
    my $self = shift;

    semctl($self->{'semid'}, 0, $IPC_RMID, 0) || 
                                die "Delete failed";
}

1;