view release on metacpan or  search on metacpan

lib/Lock/Server.pm  view on Meta::CPAN

        new Lock::Server::Client( "CLIENT_B", 'localhost', 888, $optional_args );

    if( $lockClient_A->lock( "KEYA" ) ) {
       print "Lock Successfull for locker A and KEYA\n";
    } else {
       print "Could not obtain lock in 12 seconds.\n";
    }

    # KEYA for LockerI times out after 10 seconds.
    # Lock Client B waits until it can obtain the lock
    if( $lockClient_B->lock( "KEYA" ) ) {
       print "Lock Successfull for Client B lock 'KEYA'\n";
    } else {
       print "Could not obtain lock in 12 seconds.\n";
    }

    # KEYA for LockerII is now freed. The next locker
    # attempting to lock KEYA will then obtain the lock.
    if( $lockClientB->unlock( "KEYA" ) ) {
       print "Unlock Successfull\n";
    }

    if( $lockServer->stop ) {
        print "Lock server shut down.\n";
    }

=head1 METHODS

=cut

use strict;
use warnings;
no warnings 'uninitialized';

use Data::Dumper;

use IO::Select;
use IO::Socket;

use IO::Socket::INET;
use POSIX ":sys_wait_h";
use Time::HiRes qw(ualarm usleep);

use vars qw($VERSION);

$VERSION = '1.75';


$Lock::Server::DEBUG = 0;

=head2 Lock::Server::new( $args )

 Creates a new lock server for the given optional arguments.
 
 Arguments are :
   * port - port to serve on. Defaults to 8004
   * lock_timeout - low long should a lock last in seconds
   * lock_attempt_timeout - how long should a requester
                            wait for a lock in seconds
   * allow_shutdown - allows a client to shut the server down
   * reconnect_attempts - if port is busy when starting the server
                          how many retries to connect before giving up and failing startup
   * time_between_attempts - interval between reconnection attempts

=cut
sub new {
    my( $pkg, $args ) = @_;
    my $class = ref( $pkg ) || $pkg;
    bless {
        lock_timeout         => $args->{lock_timeout} || 3,
        lock_attempt_timeout => $args->{lock_attempt_timeout} || 4,
        host                 => $args->{host} || '127.0.0.1',
        port                 => $args->{port} || 8004,
        allow_shutdown       => $args->{allow_shutdown},
        max_connections      => $args->{max_connections} || 10,
        _pids                => {},
        _id2pid              => {},
        _locks               => {},
        _locker_counts       => {},
        attempts => $args->{reconnect_attemps} || 10,
        time_between_attempts => $args->{time_between_attempts} || 5, #seconds

    }, $class;
} #new


=head2 client( lockername )

    Returns a client with the given name that can send lock and unlock requests for keys.

=cut
sub client {
    my( $self, $name, $args ) = @_;
    Lock::Server::Client->new( $name, $self->{host}, $self->{port}, $args );
}

=head2 ping

    Returns '1' if this lock server is up and running

=cut
sub ping {
    return shift->client("PING")->ping;
}

=head2 stop

    Kills the lock server, breaking off any connections that are waiting for a lock.

=cut
sub stop {
    my $self = shift;

    _log( " with '$self->{listener_socket}' socket" );
    if( $self->{listener_socket} ) {
        $self->{listener_socket}->close;
    }

    if( my $pid = $self->{server_pid} ) {
        $self->{error} = "Sending INT signal to lock server of pid '$pid'";
        _log( " Killing lock server proc $pid" );