File Coverage

blib/lib/Proc/tored/LockFile.pm
Criterion Covered Total %
statement 33 35 94.2
branch 4 8 50.0
condition 0 6 0.0
subroutine 12 13 92.3
pod 1 1 100.0
total 50 63 79.3


line stmt bran cond sub pod time code
1             package Proc::tored::LockFile;
2             # ABSTRACT: Guard actions with atomic writes
3             $Proc::tored::LockFile::VERSION = '0.18';
4              
5 4     4   251446 use warnings;
  4         10  
  4         183  
6 4     4   25 use strict;
  4         11  
  4         102  
7 4     4   450 use Moo;
  4         10060  
  4         31  
8 4     4   2384 use Carp;
  4         9  
  4         308  
9 4     4   26 use Guard qw(guard);
  4         9  
  4         175  
10 4     4   25 use Path::Tiny qw(path);
  4         8  
  4         181  
11 4     4   432 use Try::Tiny;
  4         989  
  4         243  
12 4     4   472 use Types::Standard -types;
  4         67219  
  4         72  
13              
14              
15             has file_path => (
16               is => 'ro',
17               isa => Str,
18               required => 1,
19             );
20              
21             has file => (
22               is => 'lazy',
23               isa => InstanceOf['Path::Tiny'],
24               handles => [qw(exists)],
25             );
26              
27 7     7   31903 sub _build_file { path(shift->file_path) }
28              
29              
30             sub lock {
31 27     27 1 2249   my $self = shift;
32              
33             # Existing lock file means another process came in ahead
34 27 100       636   return if $self->exists;
35              
36               my $locked = try {
37 25     25   2497       $self->file->filehandle({exclusive => 1}, '>');
38                 }
39                 catch {
40             # Rethrow if error was something other than the file already existing.
41             # Assume any 'sysopen' error matching 'File exists' is an indication
42             # of that.
43                   die $_
44 0 0 0 0   0         unless $_->{op} eq 'sysopen' && $_->{err} =~ /File exists/i
      0        
45                         || $self->exists;
46 25         2528     };
47              
48 25 50       7065   return unless $locked;
49              
50               return guard {
51 25 50       2036     try { $self->exists && $self->file->remove }
52 0               catch { carp "unable to remove lock file: $_" }
53 25     25   653   };
  25         1135  
54             }
55              
56             1;
57              
58             __END__
59            
60             =pod
61            
62             =encoding UTF-8
63            
64             =head1 NAME
65            
66             Proc::tored::LockFile - Guard actions with atomic writes
67            
68             =head1 VERSION
69            
70             version 0.18
71            
72             =head1 SYNOPSIS
73            
74             use Proc::tored::LockFile;
75            
76             my $lockfile = Proc::tored::LockFile->new(file_path => '/path/to/something.lock');
77            
78             if (my $lock = $lockfile->lock) {
79             ...
80             }
81            
82             =head1 ATTRIBUTES
83            
84             =head2 file_path
85            
86             Path where lock file should be created.
87            
88             =head1 METHODS
89            
90             =head2 lock
91            
92             Attempts to lock the guarded resource by created a new file at L</file_path>.
93             If the file could not be created because it already exists (using
94             C<O_CREAT|O_EXCL>), the lock attempt fails and undef is returned. If the lock
95             is successfully acquired, a L<Guard> object is returned that will unlink the
96             lock file as it falls out of scope.
97            
98             =head1 AUTHOR
99            
100             Jeff Ober <sysread@fastmail.fm>
101            
102             =head1 COPYRIGHT AND LICENSE
103            
104             This software is copyright (c) 2017 by Jeff Ober.
105            
106             This is free software; you can redistribute it and/or modify it under
107             the same terms as the Perl 5 programming language system itself.
108            
109             =cut
110