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

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

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

use IPC::::Locker;

use strict;

=head1 NAME

App::ResourceLocker::IPCLocker - 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 IPCLocker 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::IPCLocker

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

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

    family      IPC (fifo) family to communicate with the lock server
                INET: use TCP/IP networking
                UNIX: use Unix named pipes (created with "mknod p /path/to/fifo")
                default: INET
    host        default: localhost (only needed for INET family)
    port        default for INET: 1751 (or as defined in /etc/services for "lockerd")
                default for UNIX: /var/locks/lockerd
    timeout     Time at which the server will release the lock if not explicitly
                unlocked by then
                default: 600 sec (10 min) (0 is "unlimited")
    autounlock  Allow the locker daemon to break the lock if the locking process
                is no longer running. (Note that there is an implicit promise
                that the locking process is running on the same server as the
                locker daemon.)
    random      Lock a random resource from the pool when a pool is specified

=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});

    if ($self->{random} && ref($resource_names) eq "ARRAY") {
        my (@resources, $idx, @lastresources);
        @resources = @$resource_names;
        $idx = $$ % ($#resources + 1);
        if ($idx > 0) {
            @lastresources = splice(@resources, 0, $idx);
            push(@resources, @lastresources);
            $resource_names = \@resources;
        }
    }

    push(@params, "lock",       $resource_names);
    push(@params, "family",     $self->{family})     if (defined $self->{family});
    push(@params, "host",       $self->{host})       if (defined $self->{host});
    push(@params, "port",       $self->{port})       if (defined $self->{port});
    push(@params, "timeout",    $self->{timeout})    if (defined $self->{timeout});
    push(@params, "autounlock", $self->{autounlock}) if (defined $self->{autounlock});
    # I need to investigate more what IPC::Locker does with this name
    # I may need to use "$user-$session_id"
    # The default "name" is "$hostname-$pid" or something similar
    #push(@params, "user",  $self->{context}->user());
    push(@params, "block", ($args->{nonBlocking} ? 0 : 1));

    $lock = "";
    my $failures = 0;
    while (!$lock) {
        eval {
            $lock = IPC::Locker->lock(@params);
        };
        if ($@) {
            $failures++;
            if ($failures % 10 == 1) {
                print STDERR "lock failed $failures times: $@\n";
                print STDERR "    {", join(",",@params), "}\n";
            }
            sleep(6);
        }
    }
    
    $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};
    }
}

=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;

