line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IPC::ConcurrencyLimit::Lock::Flock; |
2
|
41
|
|
|
41
|
|
1147
|
use 5.008001; |
|
41
|
|
|
|
|
85
|
|
3
|
41
|
|
|
41
|
|
123
|
use strict; |
|
41
|
|
|
|
|
42
|
|
|
41
|
|
|
|
|
717
|
|
4
|
41
|
|
|
41
|
|
123
|
use warnings; |
|
41
|
|
|
|
|
41
|
|
|
41
|
|
|
|
|
844
|
|
5
|
41
|
|
|
41
|
|
86
|
use Carp qw(croak); |
|
41
|
|
|
|
|
39
|
|
|
41
|
|
|
|
|
1678
|
|
6
|
41
|
|
|
41
|
|
159
|
use File::Path qw(); |
|
41
|
|
|
|
|
6
|
|
|
41
|
|
|
|
|
440
|
|
7
|
41
|
|
|
41
|
|
117
|
use File::Spec; |
|
41
|
|
|
|
|
41
|
|
|
41
|
|
|
|
|
745
|
|
8
|
41
|
|
|
41
|
|
87
|
use Fcntl qw(:DEFAULT :flock); |
|
41
|
|
|
|
|
41
|
|
|
41
|
|
|
|
|
13515
|
|
9
|
41
|
|
|
41
|
|
15740
|
use IO::File (); |
|
41
|
|
|
|
|
32020
|
|
|
41
|
|
|
|
|
1113
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.15'; |
12
|
41
|
|
|
41
|
|
13029
|
use IPC::ConcurrencyLimit::Lock; |
|
41
|
|
|
|
|
44
|
|
|
41
|
|
|
|
|
16039
|
|
13
|
|
|
|
|
|
|
our @ISA = qw(IPC::ConcurrencyLimit::Lock); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
1025
|
|
|
1025
|
1
|
1228
|
my $class = shift; |
17
|
1025
|
|
|
|
|
1115
|
my $opt = shift; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $max_procs = $opt->{max_procs} |
20
|
1025
|
50
|
|
|
|
2487
|
or croak("Need a 'max_procs' parameter"); |
21
|
|
|
|
|
|
|
my $path = $opt->{path} |
22
|
1025
|
50
|
|
|
|
2367
|
or croak("Need a 'path' parameter"); |
23
|
1025
|
|
100
|
|
|
5521
|
my $lock_mode = lc($opt->{lock_mode} || 'exclusive'); |
24
|
1025
|
50
|
|
|
|
7071
|
if ($lock_mode !~ /^(?:exclusive|shared)$/) { |
25
|
0
|
|
|
|
|
0
|
croak("Invalid lock mode '$lock_mode'"); |
26
|
|
|
|
|
|
|
} |
27
|
1025
|
100
|
|
|
|
2738
|
my $file_prefix= defined $opt->{file_prefix} ? $opt->{file_prefix} : ""; |
28
|
1025
|
100
|
|
|
|
2771
|
$file_prefix .= "." if length $file_prefix; |
29
|
1025
|
50
|
|
|
|
1887
|
my $file_ext= defined $opt->{file_ext} ? $opt->{file_ext} : "lock"; |
30
|
1025
|
|
|
|
|
4412
|
$file_ext=~s/^\.?/./; |
31
|
|
|
|
|
|
|
|
32
|
1025
|
|
|
|
|
8300
|
my $self = bless { |
33
|
|
|
|
|
|
|
max_procs => $max_procs, |
34
|
|
|
|
|
|
|
path => $path, |
35
|
|
|
|
|
|
|
lock_fh => undef, |
36
|
|
|
|
|
|
|
lock_file => undef, |
37
|
|
|
|
|
|
|
id => undef, |
38
|
|
|
|
|
|
|
file_prefix => $file_prefix, |
39
|
|
|
|
|
|
|
file_ext => $file_ext, |
40
|
|
|
|
|
|
|
lock_mode => $lock_mode, |
41
|
|
|
|
|
|
|
} => $class; |
42
|
|
|
|
|
|
|
|
43
|
1025
|
100
|
|
|
|
2312
|
$self->_get_lock() or return undef; |
44
|
|
|
|
|
|
|
|
45
|
450
|
|
|
|
|
1474
|
return $self; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _get_lock { |
49
|
1025
|
|
|
1025
|
|
1128
|
my $self = shift; |
50
|
|
|
|
|
|
|
|
51
|
1025
|
|
|
|
|
2797661
|
File::Path::mkpath($self->{path}); |
52
|
1025
|
100
|
|
|
|
2663
|
my $lock_mode_flag = $self->{lock_mode} eq 'shared' ? LOCK_SH : LOCK_EX; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# We try in reverse order, so that if a processor is started with |
55
|
|
|
|
|
|
|
# a higher number of allowed locks there is less chance that it starves |
56
|
|
|
|
|
|
|
# a processor with a lower number of allowed locks. |
57
|
1025
|
|
|
|
|
3038
|
for my $worker_id (reverse 1 .. $self->{max_procs}) { |
58
|
1238
|
|
|
|
|
18025
|
my $lock_file = File::Spec->catfile($self->{path}, join("", $self->{file_prefix}, $worker_id, $self->{file_ext})); |
59
|
|
|
|
|
|
|
|
60
|
1238
|
50
|
|
|
|
45758
|
sysopen(my $fh, $lock_file, O_RDWR|O_CREAT) |
61
|
|
|
|
|
|
|
or die "can't open '$lock_file': $!"; |
62
|
|
|
|
|
|
|
|
63
|
1238
|
100
|
|
|
|
6897
|
if (flock($fh, $lock_mode_flag|LOCK_NB)) { |
64
|
450
|
|
|
|
|
792
|
$self->{lock_fh} = $fh; |
65
|
450
|
|
|
|
|
1141
|
seek($fh, 0, 0); |
66
|
450
|
|
|
|
|
3902690
|
truncate($fh, 0); |
67
|
450
|
|
|
|
|
6593
|
print $fh $$; |
68
|
450
|
|
|
|
|
4597459
|
$fh->flush; |
69
|
450
|
|
|
|
|
1259
|
$self->{id} = $worker_id; |
70
|
450
|
|
|
|
|
637
|
$self->{lock_file} = $lock_file; |
71
|
450
|
|
|
|
|
843
|
last; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
788
|
|
|
|
|
9549
|
close $fh; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
1025
|
100
|
|
|
|
5170
|
return undef if not $self->{id}; |
78
|
450
|
|
|
|
|
1185
|
return 1; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
0
|
1
|
0
|
sub lock_file { $_[0]->{lock_file} } |
82
|
0
|
|
|
0
|
1
|
0
|
sub path { $_[0]->{path} } |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub DESTROY { |
85
|
1025
|
|
|
1025
|
|
18433286
|
my $self = shift; |
86
|
|
|
|
|
|
|
# should be superfluous |
87
|
1025
|
100
|
|
|
|
14221
|
close($self->{lock_fh}) if $self->{lock_fh}; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
__END__ |