view release on metacpan or  search on metacpan

lib/Captive/Portal/LockHandle.pm  view on Meta::CPAN

package Captive::Portal::LockHandle;

use strict;
use warnings;

=head1 NAME

Captive::Portal::LockHandle - lock handling for Captive::Portal

=cut

our $VERSION = '4.10';

use Log::Log4perl qw(:easy);
use Try::Tiny;
use Time::HiRes qw(usleep ualarm);
use Fcntl qw(:flock O_CREAT O_RDWR);

use parent qw(FileHandle);

=head1 DESCRIPTION

Inherit from FileHandle, add locking and DESTROY().

=head1 CONSTRUCTION and DESTROY

=over 4

=item $handle = Captive::Portal::LockHandle->new(%options)

Returns a filehandle with the requested lock assigned. There is no unlock, after destroying the filehandle the file is automatically closed and the lock released.

Options:

 file     => filename to lock, created if not existing
 shared   => shared lock, defaults to exclusive lock
 blocking => blocking lock request, defaults to blocking
 try      => number of retries in nonblocking mode, defaults to 1 retry
 timeout  => timeout in blocking mode, defaults to 1s

=cut 

sub new {
    my $self = shift;
    my %opts = @_;

    LOGDIE "missing param 'file'" unless exists $opts{file};

    my $file = delete $opts{file};

    DEBUG "lock requested for $file";

    # make lexical scoped filehandle

    my $lock_handle = $self->SUPER::new( $file, O_RDWR | O_CREAT )
      or LOGDIE "Can't open $file: $!";

    my $fileno = $lock_handle->fileno or LOGDIE "Can't read fileno: $!";

    # defaults
    $opts{shared}   = 0         unless exists $opts{shared};
    $opts{blocking} = 1         unless exists $opts{blocking};
    $opts{try}      = 1         unless exists $opts{try};
    $opts{timeout}  = 1_000_000 unless exists $opts{timeout};    # 1s

    DEBUG "fd=$fileno, ", $opts{shared} ? 'SHARED, ' : 'EXCLUSIVE, ',
      $opts{blocking}
      ? "BLOCKING, timeout $opts{timeout} us"
      : "NONBLOCKING, retry $opts{try}";

    my $mode;
    if ( $opts{shared} ) {
        $mode = LOCK_SH;
    }
    else {