
#############################################################################
## $Id: IPCSemaphore.pm 6783 2006-08-11 17:43:28Z spadkins $
#############################################################################

package App::ResourceLocker::IPCSemaphore;
$VERSION = (q$Revision: 6783 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::ResourceLocker;
@ISA = ( "App::ResourceLocker" );

use IPC::SysV qw(IPC_PRIVATE IPC_CREAT IPC_EXCL IPC_NOWAIT SEM_UNDO);
use IPC::Semaphore;

use strict;

=head1 NAME

App::ResourceLocker::IPCSemaphore - locking shared resources using IPC::Locker

=head1 SYNOPSIS

    use App;

    $context = App->context();
    $srs = $context->service("ResourceLocker");  # or ...
    $srs = $context->shared_resource_set();

=head1 DESCRIPTION

A ResourceLocker service represents a collection of "advisory"
(or "cooperative")
resource locks.  The IPCSemaphore implementation uses the IPC::Locker
distribution available on CPAN.  Locking is implemented by a Locker Daemon
(lockerd), so that locking may be effectively achieved across an entire
network.

=cut

#############################################################################
# CLASS
#############################################################################

=head1 Class: App::ResourceLocker::IPCSemaphore

A ResourceLocker service represents a collection of "advisory"
(or "cooperative") resource locks. 
These can be used to synchronize access to and modification
of shared resources such as are stored in a SharedDatastore.

 * Throws: App::Exception::ResourceLocker
 * Since:  0.01

Generally speaking, this module only works on Unix platforms, because they
support the System V semaphore API on which the IPC::Semaphore module
is built.

The ResourceLocker may be configured with the following parameters, which
govern all locks accessed in the ResourceLocker (as per IPC::Semaphore).

    semkey      an 8-digit hex key (i.e. 0x1234FA78) uniquely identifying the
                semaphore set (or may be "private", not shared with any other
                processes, useful only for multi-threaded applications).
                If the ResourceLocker needs more than one semaphore set,
                it will allocation additional sets with keys incremented by
                1 from this semkey.
                default: 0x95EE10CC
    nsems       number of semaphores to get (limited by kernel settings)
                in each semaphore set
                default: 100
    create      boolean whether to create the semaphore set if it does not
                exist already
                default: 1
    mode        permissions mode with which to create the semaphore set
                default: 0600

=cut

#############################################################################
# CONSTRUCTOR METHODS
#############################################################################

=head1 Constructor Methods:

=cut

#############################################################################
# new()
#############################################################################

=head2 new()

The constructor is inherited from
L<C<App::Service>|App::Service/"new()">.

=cut

#############################################################################
# PUBLIC METHODS
#############################################################################

=head1 Public Methods:

=cut

#############################################################################
# lock()
#############################################################################

=head2 lock()

    * Signature: $resource_name = $srs->lock($resource_pool);
    * Signature: $resource_name = $srs->lock($resource_set);
    * Signature: $resource_name = $srs->lock($named);
    * Param:     $resource_pool          string
    * Param:     $resource_set           []
    * Param:     resourcePool            string
    * Param:     nonBlocking             boolean
    * Param:     nonExclusive            boolean
    * Param:     maxWaitTimeMS           integer
    * Return:    $resource_name          string
    * Throws:    App::Exception::ResourceLocker
    * Since:     0.01

    Sample Usage: 

    $context = App->context();
    $srs = $context->service("ResourceLocker");
    $srs->lock("shmem01");

The lock() method on a ResourceLocker is for the purposes of cooperative
resource locking.

The "nonBlocking" option works in this implementation.
However, all locks are exclusive (the nonExclusive option is ignored).
The "maxWaitTimeMS" option is not yet implemented.

=cut

sub lock {
    my ($self, $arg) = @_;
    my ($resource_pool, $args);
    if (ref($arg) eq "HASH") {
        $resource_pool = $arg->{resourcePool};
        $args = $arg;
    }
    elsif (ref($arg) eq "ARRAY") {
        $resource_pool = $arg;
        $args = {};
    }
    elsif (ref($arg) eq "") {
        $resource_pool = $arg;
        $args = {};
    }
    return undef if (! $resource_pool);

    my (@params, $lock, $resource_names, $resource_name);

    # substitute the list of items in the pool for the pool name
    $resource_names = $resource_pool;
    $resource_names = $self->{resourcePool}{$resource_pool}
        if (defined $self->{resourcePool}{$resource_pool});

    push(@params, "lock",       $resource_names);
    push(@params, "timeout",    $self->{timeout})    if (defined $self->{timeout});
    push(@params, "autounlock", $self->{autounlock}) if (defined $self->{autounlock});
    push(@params, "block",      ($args->{nonBlocking} ? 0 : 1));

    $lock = $self->_lock(@params);
    $resource_name = $lock->lock_name();

    if (defined $resource_name) {
        $self->{lock}{$resource_name} = $lock;  # save for later unlocking
    }

    return ($resource_name);
}

#############################################################################
# unlock()
#############################################################################

=head2 unlock()

    * Signature: $srs->unlock($resource_name);
    * Param:     $resource_name          string
    * Return:    void
    * Throws:    App::Exception::ResourceLocker
    * Since:     0.01

    Sample Usage: 

    $context = App->context();
    $srs = $context->service("ResourceLocker");
    $srs->unlock("shmem01");

=cut

sub unlock {
    my ($self, $resource_name) = @_;
    my ($lock);
    $lock = $self->{lock}{$resource_name};
    if (defined $lock) {
        $lock->unlock();
        delete $self->{lock}{$resource_name};
    }
}

#############################################################################
# PROTECTED METHODS
#############################################################################

=head1 Protected Methods:

=cut

#############################################################################
# _init()
#############################################################################

=head2 _init()

    * Signature: $self->_init();
    * Param:     void
    * Return:    void
    * Throws:    App::Exception::ResourceLocker
    * Since:     0.01

    Sample Usage: 

    $self->_init();

The _init() method is called from within the constructor to allow the class
to customize itself.

=cut

sub _init {
    my ($self) = @_;

    $self->{semset} = {};
    $self->{semnum} = {};
    $self->{semset_list} = [];
    $self->{resource_name_grid} = [];
}

#############################################################################
# allocate()
#############################################################################

=head2 allocate()

    * Signature: ($semset, $semnum) = $self->allocate($resource_name);
    * Param:     $resource_name    string
    * Return:    $semset           IPC::Semaphore
    * Return:    $semnum           integer
    * Throws:    App::Exception::ResourceLocker
    * Since:     0.01

    Sample Usage: 

    ($semset, $semnum) = $self->allocate($resource_name);

The allocate() method is called when $self->{semset}{$resource_name} is not
defined in order to allocate an appropriate ($semset, $semnum) pair for a
$resource_name.

=cut

sub allocate {
    my ($self,$resource_name) = @_;
    my ($semset, $semnum);

    # check again to see if there is already a semaphore allocated
    if (defined $self->{semset}{$resource_name}) {
       $semset = $self->{semset}{$resource_name};
       $semnum = $self->{semnum}{$resource_name};
       return($semset, $semnum);
    }

    my ($semset_list, $resource_name_grid);
    $semset_list        = $self->{semset_list};
    $resource_name_grid = $self->{resource_name_grid};

    # find an available semaphore
    my ($nsemset);
    for ($nsemset = 0; $nsemset <= $#$semset_list; $nsemset++) {
        for ($semnum = 0; $semnum <= $#$semset_list; $semnum++) {
            if (!defined $resource_name_grid->[$nsemset][$semnum]) {
                $resource_name_grid->[$nsemset][$semnum] = $resource_name;
                $semset = $semset_list->[$nsemset];
                $self->{semset}{$resource_name} = $semset;
                $self->{semnum}{$resource_name} = $semnum;
                return($semset, $semnum);
            }
        }
    }

    # allocate a new set of semaphores
    my ($semkey, $nsems, $create, $exclusive, $mode);
    $semkey    = ($self->{semkey}    || 0x95EE10CC);
    $semkey    = IPC_PRIVATE if ($semkey eq "private");
    $nsems     = ($self->{nsems}     || 100);
    $create    = ($self->{create}    || 1);
    $exclusive = ($self->{exclusive} || 1);
    $mode      = ($self->{mode}      || 0600);
    $mode     |= IPC_CREAT   if ($create);
    $mode     |= IPC_EXCL    if ($exclusive);

    $semset = IPC::Semaphore->new($semkey, $nsems, $mode);

    push(@$semset_list, $semset);
    $nsemset = $#$semset_list;
    $semnum = 0;  # allocate the first one
    $resource_name_grid->[$nsemset][$semnum] = $resource_name;
    $self->{semset}{$resource_name} = $semset;
    $self->{semnum}{$resource_name} = $semnum;
    return($semset, $semnum);
}

#############################################################################
# free()
#############################################################################

=head2 free()

    * Signature: $self->free($resource_name);
    * Param:     $resource_name     string
    * Return:    void
    * Throws:    App::Exception::ResourceLocker
    * Since:     0.01

    Sample Usage: 

    $self->free($resource_name);

The free() method frees up a resource name so that its physical semaphore
may be reused for some other resource.

=cut

sub free {
    my ($self, $resource_name) = @_;

}

=head1 ACKNOWLEDGEMENTS

 * Author:  Stephen Adkins <spadkins@gmail.com>
 * License: This is free software. It is licensed under the same terms as Perl itself.

=head1 SEE ALSO

L<C<App::ResourceLocker>|App::ResourceLocker>,
L<C<App::Context>|App::Context>,
L<C<App::Service>|App::Service>

=cut

1;

__END__

static int semid;
static struct sembuf lock_op, unlock_op;

int start_lib_lock()
{
   int err, i, lastpid, semnum;
   lock_op.sem_op  = -1;   /* Lock() decrements to 0 if sem value is 1  */
   lock_op.sem_flg = 0;    /* wait until semaphore available            */
   unlock_op.sem_op  = 1;  /* Unlock() increments sem value from 0 to 1 */
   unlock_op.sem_flg = 0;  /* ??? positive sem_op values never wait     */

   semid = semget(SEM_KEY,MAX_LOCKS,RWMODE);
   if (semid == ERROR) {
      semid = semget(SEM_KEY,MAX_LOCKS,RWMODE|IPC_CREAT);
      if (semid == ERROR)
         log(semid,"start_lib_lock():semget");
   }
   if (semid != ERROR) {
      for (semnum=0; semnum < MAX_LOCKS; semnum++) {
         lastpid = xsemctl(semid,semnum,GETPID);
         if (xkill(lastpid,NULLSIG) == ERROR) {
            if (xsemctl(semid,semnum,SETVAL,(char *) 1) == ERROR)
               log_fcn("start_lib_lock(2):semctl",__FILE__);
         }
      }
   }
   return(semid);
}

Lock (locknum)
int locknum;
{
   if (dbg(LOCK))
      dbg_printf("%-5d Lock(%d)\n",getpid(),locknum);
   lock_op.sem_num = locknum;
   log(semop(semid,&lock_op,1),"Lock");
}

Unlock (locknum)
int locknum;
{
   if (dbg(UNLOCK))
      dbg_printf("%-5d Unlock(%d)\n",getpid(),locknum);
   unlock_op.sem_num = locknum;
   log(semop(semid,&unlock_op,1),"Unlock");
}

