File Coverage

blib/lib/DDLock/Client/File.pm

Criterion	Covered	Total	%
statement	15	62	24.1
branch	0	26	0.0
condition	0	7	0.0
subroutine	5	12	41.6
pod	0	6	0.0
total	20	113	17.7

package DDLock::Client::File;

use Fcntl qw{:DEFAULT :flock};
use File::Spec qw{};
use File::Path qw{mkpath};
use IO::File qw{};

use fields qw{name path tmpfile pid hooks};

our $TmpDir = File::Spec->tmpdir;

### (CONSTRUCTOR) METHOD: new( $lockname )
### Createa a new file-based lock with the specified I.
sub new {
    my DDLock::Client::File $self = shift;
    $self = fields::new( $self ) unless ref $self;
    my ( $name, $lockdir ) = @_;

    $self->{pid} = $$;

    $lockdir ||= $TmpDir;
    if ( ! -d $lockdir ) {
        # Croaks if it fails, so no need for error-checking
        mkpath $lockdir;
    }

    my $lockfile = File::Spec->catfile( $lockdir, eurl($name) );

    # First open a temp file
    my $tmpfile = "$lockfile.$$.tmp";
    if ( -e $tmpfile ) {
        unlink $tmpfile or die "unlink: $tmpfile: $!";
    }

    my $fh = new IO::File $tmpfile, O_WRONLY|O_CREAT|O_EXCL
        or die "open: $tmpfile: $!";
    $fh->close;
    undef $fh;

    # Now try to make a hard link to it
    link( $tmpfile, $lockfile )
        or die "link: $tmpfile -> $lockfile: $!";
    unlink $tmpfile or die "unlink: $tmpfile: $!";

    $self->{path} = $lockfile;
    $self->{tmpfile} = $tmpfile;
    $self->{hooks} = {};

    return $self;
}

sub name {
    my DDLock::Client::File $self = shift;
    return $self->{name};
}

sub set_hook {
    my DDLock::Client::File $self = shift;
    my $hookname = shift || return;

    if (@_) {
        $self->{hooks}->{$hookname} = shift;
    } else {
        delete $self->{hooks}->{$hookname};
    }
}

sub run_hook {
    my DDLock::Client::File $self = shift;
    my $hookname = shift || return;

    if (my $hook = $self->{hooks}->{$hookname}) {
        local $@;
        eval { $hook->($self) };
        warn "DDLock::Client::File hook '$hookname' threw error: $@" if $@;
    }
}

### METHOD: release()
### Release the lock held by the object.
sub release {
    my DDLock::Client::File $self = shift;
    $self->run_hook('release');
    return unless $self->{path};
    unlink $self->{path} or die "unlink: $self->{path}: $!";
    unlink $self->{tmpfile};
}


### FUNCTION: eurl( $arg )
### URL-encode the given I and return it.
sub eurl
{
    my $a = $_[0];
    $a =~ s/([^a-zA-Z0-9_,.\\: -])/sprintf("%%%02X",ord($1))/eg;
    $a =~ tr/ /+/;
    return $a;
}


DESTROY {
    my $self = shift;
    $self->run_hook('DESTROY');
    $self->release if $$ == $self->{pid};
}

1;


# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: