line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IPC::ConcurrencyLimit::Lock::MySQL; |
2
|
2
|
|
|
2
|
|
75998
|
use 5.008001; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
84
|
|
3
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
76
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
95
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
11
|
use Carp qw(croak); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
322
|
|
9
|
|
|
|
|
|
|
use Class::XSAccessor { |
10
|
2
|
|
|
|
|
25
|
accessors => [qw(dbh id timeout)], |
11
|
|
|
|
|
|
|
getters => [qw(make_new_dbh_callback lock_name)], |
12
|
2
|
|
|
2
|
|
2019
|
}; |
|
2
|
|
|
|
|
8102
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
3787
|
use IPC::ConcurrencyLimit::Lock; |
|
2
|
|
|
|
|
349
|
|
|
2
|
|
|
|
|
1303
|
|
15
|
|
|
|
|
|
|
our @ISA = qw(IPC::ConcurrencyLimit::Lock); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
19
|
0
|
|
|
|
|
|
my $opt = shift; |
20
|
|
|
|
|
|
|
|
21
|
0
|
0
|
|
|
|
|
my $max_procs = $opt->{max_procs} |
22
|
|
|
|
|
|
|
or croak("Need a 'max_procs' parameter"); |
23
|
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
|
my $dbh_callback = $opt->{make_new_dbh}; |
25
|
0
|
0
|
0
|
|
|
|
$dbh_callback && ref($dbh_callback) eq 'CODE' |
26
|
|
|
|
|
|
|
or croak("Need a 'make_new_dbh' callback as parameter"); |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
my $lock_name = $opt->{lock_name}; |
29
|
0
|
0
|
|
|
|
|
defined $lock_name |
30
|
|
|
|
|
|
|
or croak("Need a 'lock_name' parameter for the lock"); |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
0
|
|
|
|
my $self = bless { |
33
|
|
|
|
|
|
|
lock_name => $lock_name, |
34
|
|
|
|
|
|
|
max_procs => $max_procs, |
35
|
|
|
|
|
|
|
make_new_dbh_callback => $dbh_callback, |
36
|
|
|
|
|
|
|
timeout => $opt->{timeout}||0, |
37
|
|
|
|
|
|
|
dbh => undef, |
38
|
|
|
|
|
|
|
id => undef, |
39
|
|
|
|
|
|
|
} => $class; |
40
|
|
|
|
|
|
|
|
41
|
0
|
0
|
|
|
|
|
$self->_get_lock() or return undef; |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
return $self; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub _get_dbh { |
47
|
0
|
|
|
0
|
|
|
my $self = shift; |
48
|
0
|
|
|
|
|
|
my $dbh = $self->dbh; |
49
|
|
|
|
|
|
|
|
50
|
0
|
0
|
|
|
|
|
if (not defined $dbh) { |
51
|
0
|
|
|
|
|
|
$dbh = $self->make_new_dbh_callback->($self); |
52
|
0
|
0
|
|
|
|
|
die "Could not get a DB handle for getting a lock" |
53
|
|
|
|
|
|
|
if not defined $dbh; |
54
|
0
|
|
|
|
|
|
$self->dbh($dbh); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
|
|
|
return $dbh; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _get_lock { |
61
|
0
|
|
|
0
|
|
|
my $self = shift; |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
my $dbh = $self->_get_dbh; |
64
|
0
|
|
|
|
|
|
my $lock_name_base = $self->lock_name; |
65
|
0
|
|
|
|
|
|
my $timeout = $self->timeout; |
66
|
0
|
|
|
|
|
|
for my $worker (1 .. $self->{max_procs}) { |
67
|
0
|
|
|
|
|
|
my $lock_name = $lock_name_base . "_" . $worker; |
68
|
0
|
|
|
|
|
|
my $query = "SELECT GET_LOCK(?, ?)"; |
69
|
0
|
|
|
|
|
|
my $res = $dbh->selectcol_arrayref($query, undef, $lock_name, $timeout); |
70
|
0
|
0
|
0
|
|
|
|
if (not defined $res or not ref($res) eq 'ARRAY') { |
71
|
0
|
|
|
|
|
|
die "Failed to execute query '$query': " . $dbh->errstr; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
0
|
0
|
|
|
|
if (@$res && $res->[0]) { |
74
|
0
|
|
|
|
|
|
$self->id($worker); |
75
|
0
|
|
|
|
|
|
last; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
0
|
0
|
|
|
|
|
return undef if not $self->{id}; |
80
|
0
|
|
|
|
|
|
return 1; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub _release_lock { |
84
|
0
|
|
|
0
|
|
|
my $self = shift; |
85
|
0
|
|
|
|
|
|
my $dbh = $self->dbh; |
86
|
0
|
0
|
|
|
|
|
return if not $dbh; |
87
|
0
|
|
|
|
|
|
my $id = $self->id; |
88
|
0
|
0
|
|
|
|
|
return if not $id; |
89
|
0
|
|
|
|
|
|
my $query = "SELECT RELEASE_LOCK(?)"; |
90
|
0
|
|
|
|
|
|
$dbh->do($query, undef, $self->lock_name . "_" . $id); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub DESTROY { |
94
|
0
|
|
|
0
|
|
|
my $self = shift; |
95
|
0
|
|
|
|
|
|
$self->_release_lock(); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
1; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
__END__ |