File Coverage

blib/lib/JIP/LockSocket.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	17	18	94.4
condition	5	6	83.3
subroutine	14	14	100.0
pod	0	4	0.0
total	83	89	93.2

package JIP::LockSocket;

use 5.006;
use strict;
use warnings;
use JIP::ClassField;
use Carp qw(croak);
use English qw(-no_match_vars);
use Socket qw(inet_aton pack_sockaddr_in PF_INET SOCK_STREAM);

our $VERSION = '0.02';

map { has $_ => (get => '+', set => '-') } qw(port addr socket is_locked);

sub new {
    my ($class, %param) = @ARG;

    # Mandatory options
    croak qq{Mandatory argument "port" is missing\n}
        unless exists $param{'port'};

    # Check "port"
    my $port = $param{'port'};
    croak qq{Bad argument "port"\n}
        unless defined $port and $port =~ m{^\d+$}x;

    # Check "addr"
    my $addr = (exists $param{'addr'} and length $param{'addr'})
        ? $param{'addr'} : '127.0.0.1';

    # Class to object
    return bless({}, $class)
        ->_set_is_locked(0)
        ->_set_port($port)
        ->_set_addr($addr)
        ->_set_socket(undef);
}

# Lock or raise an exception
sub lock {
    my $self = shift;

    # Re-locking changes nothing
    return $self if $self->is_locked;

    my $socket = $self->_init_socket;

    bind($socket, pack_sockaddr_in($self->port, $self->_get_inet_addr))
        or croak(sprintf qq{Can't lock port "%s": %s\n}, $self->port, $OS_ERROR);

    return $self->_set_socket($socket)->_set_is_locked(1);
}

# Or just return undef
sub try_lock {
    my $self = shift;

    # Re-locking changes nothing
    return $self if $self->is_locked;

    my $socket = $self->_init_socket;

    if (bind($socket, pack_sockaddr_in($self->port, $self->_get_inet_addr))) {
        return $self->_set_socket($socket)->_set_is_locked(1);
    }
    else {
        return;
    }
}

# You can manually unlock
sub unlock {
    my $self = shift;

    # Re-unlocking changes nothing
    return $self if not $self->is_locked;

    return $self->_set_socket(undef)->_set_is_locked(0);
}

# unlocking on scope exit
sub DESTROY {
    my $self = shift;
    return $self->unlock;
}

sub _get_inet_addr {
    my $self = shift;
    return inet_aton($self->addr);
}

sub _init_socket {
    socket(my $socket, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
        or croak(sprintf qq{Can't init socket: %s\n}, $OS_ERROR);

    return $socket;
}

1;

__END__