File Coverage

lib/Ubic/SingletonLock.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	2	2	100.0
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	36	36	100.0

package Ubic::SingletonLock;
$Ubic::SingletonLock::VERSION = '1.58_01'; # TRIAL
use strict;
use warnings;

# ABSTRACT: lock which can be safely created several times from the same process without deadlocking


use Params::Validate;
use Scalar::Util qw(weaken);

use Ubic::Lockf;

our %LOCKS;

sub new {
    my ($class, $file, $options) = validate_pos(@_, 1, 1, 0);

    if ($LOCKS{$file}) {
        return $LOCKS{$file};
    }
    my $lock = lockf($file, $options);
    my $self = bless { file => $file, lock => $lock } => $class;

    $LOCKS{$file} = $self;
    weaken $LOCKS{$file};
    return $self;
}

sub DESTROY {
    my $self = shift;
    local $@;
    delete $LOCKS{ $self->{file} };
}


1;

__END__