| File: | blib/lib/App/FileSync/Lock.pm |
| Coverage: | 98.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::FileSync::Lock; | |||||
| 2 | ||||||
| 3 | # An advisory lock file, so two runs (cron firing while the previous run is | |||||
| 4 | # still going, or reindex racing a session) never work on the same tree. | |||||
| 5 | ||||||
| 6 | 315 315 315 | 78432 273 4205 | use App::FileSync::Platform; | |||
| 7 | ||||||
| 8 | 315 315 315 | 511 244 2806 | use strict; | |||
| 9 | 315 315 315 | 448 201 5948 | use warnings; | |||
| 10 | 315 315 315 | 739 6406 723 | use autodie qw(:all); | |||
| 11 | ||||||
| 12 | 315 315 315 | 847889 310 18153 | use Fcntl qw(:flock); | |||
| 13 | 315 315 315 | 699 229 6354 | use File::Basename qw(dirname); | |||
| 14 | ||||||
| 15 | 315 315 315 | 689 266 4800 | use App::FileSync::Args qw(named); | |||
| 16 | 315 315 315 | 695 195 4785 | use App::FileSync::IO qw(ensure_dir open_file); | |||
| 17 | ||||||
| 18 | 315 315 315 | 523 210 866 | use version; our $VERSION = version->declare('0.001.1'); | |||
| 19 | ||||||
| 20 | =encoding utf8 | |||||
| 21 | ||||||
| 22 - 82 | =head1 NAME
App::FileSync::Lock - advisory lock files
=head1 SYNOPSIS
my $lock = App::FileSync::Lock::acquire(path => $path, nonblock => 1)
or exit 2; # another run holds it
# ... the lock is released when $lock goes out of scope
=head1 FUNCTIONS
=head2 acquire
Purpose: take an exclusive C<flock> on a file.
Args: C<path> (required), C<nonblock> (return at once instead of waiting).
Returns: the filehandle holding the lock, or C<undef> when C<nonblock> is set
and another process holds it. The lock lasts until the handle is closed or
goes out of scope.
Side Effects: creates the file and its directory if needed.
Usage:
my $lock = App::FileSync::Lock::acquire(path => $lock_path, nonblock => 1);
=head3 EXAMPLE
if (my $lock = App::FileSync::Lock::acquire(path => '/tmp/demo.lock', nonblock => 1)) {
print "got it\n";
}
=head3 API SPECIFICATION
=head4 INPUT
{
path => { type => 'string', min => 1 },
nonblock => { type => 'boolean', optional => 1 },
}
=head4 OUTPUT
{ type => 'handle', optional => 1 }
=head3 MESSAGES
Key Meaning Resolution
args.invalid no path was given pass path
io.append the lock file cannot be made check permissions
=head3 FORMAL SPECIFICATION
ΔLocks
path? : PATH ; nb? : 𔹠; h! : HANDLE ∪ {⊥}
path? ∉ dom Locks ⇒ h! ≠⊥ ∧ Locks' = Locks ∪ {path? ↦ self}
path? ∈ dom Locks ∧ nb? ⇒ h! = ⊥ ∧ Locks' = Locks
=cut | |||||
| 83 | ||||||
| 84 | sub acquire { | |||||
| 85 | 360 | 5200 | my $args = named(\@_, { | |||
| 86 | path => { type => 'string', min => 1 }, | |||||
| 87 | nonblock => { type => 'boolean', optional => 1 }, | |||||
| 88 | }, 'Lock::acquire'); | |||||
| 89 | ||||||
| 90 | 360 | 674 | my $path = $args->{path}; | |||
| 91 | 360 | 8891 | ensure_dir(dirname($path)); | |||
| 92 | ||||||
| 93 | # Append mode creates the file without truncating one another process | |||||
| 94 | # has open. | |||||
| 95 | 360 | 694 | my $fh = open_file($path, '>>'); | |||
| 96 | ||||||
| 97 | # autodie's flock returns false (rather than dying) when a non-blocking | |||||
| 98 | # lock would block, which is exactly the "someone else has it" answer. | |||||
| 99 | 360 | 931 | my $flags = LOCK_EX | ($args->{nonblock} ? LOCK_NB : 0); | |||
| 100 | 360 | 1125 | my $held = flock($fh, $flags); | |||
| 101 | 360 | 42763 | close $fh unless $held; | |||
| 102 | ||||||
| 103 | 360 | 4767 | return $held ? $fh : undef; | |||
| 104 | } | |||||
| 105 | ||||||
| 106 | 1; | |||||
| 107 | ||||||