File Coverage

blib/lib/KinoSearch1/Store/FSLock.pm
Criterion Covered Total %
statement 44 44 100.0
branch 13 20 65.0
condition 2 3 66.6
subroutine 12 12 100.0
pod 1 4 25.0
total 72 83 86.7


line stmt bran cond sub pod time code
1             package KinoSearch1::Store::FSLock;
2 40     40   51770 use strict;
  40         72  
  40         1280  
3 40     40   202 use warnings;
  40         75  
  40         1435  
4 40     40   1410 use KinoSearch1::Util::ToolSet;
  40         73  
  40         1879247  
5 40     40   262 use base qw( KinoSearch1::Store::Lock );
  40         79  
  40         26401  
6              
7 40     40   409 BEGIN { __PACKAGE__->init_instance_vars() }
8              
9 40     40   238 use Fcntl qw( :DEFAULT :flock );
  40         1413  
  40         20561  
10 40     40   1782 use File::Spec::Functions qw( catfile );
  40         3115  
  40         2055  
11 40     40   1454 use KinoSearch1::Store::FSInvIndex;
  40         74  
  40         21690  
12              
13             my $disable_locks = 0; # placeholder -- locks always enabled for now
14              
15             sub init_instance {
16 71     71 1 113 my $self = shift;
17              
18             # derive the lockfile's filepath
19 71         473 $self->{lock_name} = catfile(
20             $KinoSearch1::Store::FSInvIndex::LOCK_DIR, # TODO fix this stupid hack
21             $self->{invindex}->get_lock_prefix . "-$self->{lock_name}"
22             );
23             }
24              
25             sub do_obtain {
26 71     71 0 110 my $self = shift;
27              
28 71 50       189 return 1 if $disable_locks;
29              
30 71         183 my $lock_name = $self->{lock_name};
31              
32             # check for locks created by old processes and remove them
33 71 100       2132 if ( -e $lock_name ) {
34 2 50       115 open( my $fh, $lock_name ) or confess "Can't open $lock_name: $!";
35 2         108 my $line = <$fh>;
36 2         18 $line =~ /pid: (\d+)/;
37 2         17 my $pid = $1;
38 2 50       40 close $fh or confess "Can't close '$lock_name': $!";
39 2 100       45 unless ( kill 0 => $pid ) {
40 1         27 warn "Lockfile looks dead - removing";
41 1 50       126 unlink $lock_name or confess "Can't unlink '$lock_name: $!";
42             }
43             }
44              
45             # create a lock by creating a lockfile
46             return
47 71 100       5606 unless sysopen( my $fh, $lock_name, O_CREAT | O_WRONLY | O_EXCL );
48              
49             # print pid and path to the lock file, using YAML for future compat
50 70         602 print $fh "pid: $$\ninvindex: " . $self->{invindex}->get_path . "\n";
51 70 50       4136 close $fh or confess "Can't close '$lock_name': $!";
52              
53             # success!
54 70         344 return 1;
55             }
56              
57             sub release {
58 68     68 0 116 my $self = shift;
59              
60 68 50       168 return if $disable_locks;
61              
62             # release the lock by removing the lockfile from the file system
63 68 50       5957 unlink $self->{lock_name}
64             or confess("Couldn't unlink file '$self->{lock_name}': $!");
65             }
66              
67             sub is_locked {
68             # if the lockfile exists, the resource is locked
69 69   66 69 0 2879 return ( -e $_[0]->{lock_name} or $disable_locks );
70             }
71              
72             1;
73              
74             __END__