File Coverage

File:Dpkg/Lock.pm
Coverage:61.5%

linestmtbrancondsubpodtimecode
1# Copyright © 2011 Raphaël Hertzog <hertzog@debian.org>
2# Copyright © 2012 Guillem Jover <guillem@debian.org>
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2 of the License, or
7# (at your option) any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program.  If not, see <https://www.gnu.org/licenses/>.
16
17=encoding utf8
18
19 - 29
=head1 NAME

Dpkg::Lock - file locking support

=head1 DESCRIPTION

This module implements locking functions used to support parallel builds.

B<Note>: This is a private module, its API can change at any time.

=cut
30
31package Dpkg::Lock 0.01;
32
33
3
3
3
3
8
5
53
use strict;
34
3
3
3
3
7
2
118
use warnings;
35
36our @EXPORT = qw(
37    file_lock
38);
39
40
3
3
3
3
8
2
71
use Exporter qw(import);
41
3
3
3
3
6
10
227
use Fcntl qw(:flock);
42
43
3
3
3
3
407
5
126
use Dpkg::Gettext;
44
3
3
3
3
722
2
292
use Dpkg::ErrorHandling;
45
46sub file_lock($$) {
47
0
0
0
    my ($fh, $filename) = @_;
48
49    # A strict dependency on libfile-fcntllock-perl being it an XS module,
50    # and dpkg-dev indirectly making use of it, makes building new perl
51    # package which bump the perl ABI impossible as these packages cannot
52    # be installed alongside.
53
0
    eval q{
54        use File::FcntlLock;
55    };
56
0
0
    if ($@) {
57        # On Linux systems the flock() locks get converted to file-range
58        # locks on NFS mounts.
59
0
0
        if ($^O ne 'linux') {
60
0
            warning(g_('File::FcntlLock not available; using flock which is not NFS-safe'));
61        }
62
0
0
        flock($fh, LOCK_EX)
63            or syserr(g_('failed to get a write lock on %s'), $filename);
64    } else {
65
0
        eval q{
66            my $fs = File::FcntlLock->new(l_type => F_WRLCK);
67            $fs->lock($fh, F_SETLKW)
68                or syserr(g_('failed to get a write lock on %s'), $filename);
69        }
70    }
71}
72
73 - 79
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
80
811;