Dpkg::File: Refactor file locking logic into this new module

Move libfile-fcntllock-perl dependency from dpkg-dev to libdpkg-perl.

debian/changelog

@@ -47,6 +47,8 @@ dpkg (1.16.4) UNRELEASED; urgency=low
     Closes: #674674
   * Fix start-stop-daemon to not follow symlinks when creating pidfiles.
     Thanks to Carsten Hey <carsten@debian.org>. Closes: #675918
+  * Refactor the file locking logic into a new Dpkg::File module, and move
+    the libfile-fcntllock-perl dependency from dpkg-dev to libdpkg-perl.
 
   [ Updated man page translations ]
   * German (Helge Kreutzmann).

debian/control

@@ -51,7 +51,7 @@ Section: utils
 Priority: optional
 Architecture: all
 Multi-Arch: foreign
-Depends: libdpkg-perl (= ${source:Version}), libfile-fcntllock-perl, bzip2, xz-utils,
+Depends: libdpkg-perl (= ${source:Version}), bzip2, xz-utils,
  patch, make, binutils, base-files (>= 5.0.0), ${misc:Depends}
 Recommends: gcc | c-compiler, build-essential, fakeroot, gnupg, gpgv, libalgorithm-merge-perl
 Suggests: debian-keyring
@@ -68,7 +68,7 @@ Section: perl
 Priority: optional
 Architecture: all
 Multi-Arch: foreign
-Depends: dpkg (>= 1.15.8), perl, libtimedate-perl, ${misc:Depends}
+Depends: dpkg (>= 1.15.8), perl, libtimedate-perl, libfile-fcntllock-perl, ${misc:Depends}
 Recommends: bzip2, xz-utils
 Suggests: debian-keyring, gnupg, gpgv, gcc | c-compiler, binutils, patch
 Breaks: dpkg-dev (<< 1.15.6)

scripts/Dpkg/File.pm

@@ -0,0 +1,39 @@
+# Copyright © 2011 Raphaël Hertzog <hertzog@debian.org>
+# Copyright © 2012 Guillem Jover <guillem@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Dpkg::File;
+
+use strict;
+use warnings;
+
+our $VERSION = "0.01";
+
+use File::FcntlLock;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+use base qw(Exporter);
+our @EXPORT = qw(file_lock);
+
+sub file_lock($$) {
+    my ($fh, $filename) = @_;
+
+    my $fs = File::FcntlLock->new(l_type => F_WRLCK);
+    $fs->lock($fh, F_SETLKW) ||
+        syserr(_("failed to get a write lock on %s"), $filename);
+}
+
+1;

scripts/Makefile.am

@@ -76,6 +76,7 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Deps.pm \
 	Dpkg/ErrorHandling.pm \
 	Dpkg/Exit.pm \
+	Dpkg/File.pm \
 	Dpkg/Gettext.pm \
 	Dpkg/Index.pm \
 	Dpkg/Interface/Storable.pm \

scripts/dpkg-distaddfile.pl

@@ -20,12 +20,12 @@
 use strict;
 use warnings;
 
-use File::FcntlLock;
 use POSIX;
 use POSIX qw(:errno_h :signal_h);
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
+use Dpkg::File;
 
 textdomain("dpkg-dev");
 
@@ -77,12 +77,10 @@ my ($file, $section, $priority) = @ARGV;
 
 # Obtain a lock on debian/control to avoid simultaneous updates
 # of debian/files when parallel building is in use
-my $fs = File::FcntlLock->new(l_type => F_WRLCK);
 my $lockfh;
 sysopen($lockfh, "debian/control", O_WRONLY) ||
     syserr(_g("cannot write %s"), "debian/control");
-$fs->lock($lockfh, F_SETLKW) ||
-    syserr(_("failed to get a write lock on %s"), "debian/control");
+file_lock($lockfh, "debian/control");
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y, "> $fileslistfile.new") || syserr(_g("open new files list file"));

scripts/dpkg-gencontrol.pl

@@ -22,12 +22,12 @@
 use strict;
 use warnings;
 
-use File::FcntlLock;
 use POSIX;
 use POSIX qw(:errno_h);
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
+use Dpkg::File;
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
 use Dpkg::Package;
 use Dpkg::Deps;
@@ -336,12 +336,10 @@ for my $f (keys %remove) {
 
 # Obtain a lock on debian/control to avoid simultaneous updates
 # of debian/files when parallel building is in use
-my $fs = File::FcntlLock->new(l_type => F_WRLCK);
 my $lockfh;
 sysopen($lockfh, "debian/control", O_WRONLY) ||
     syserr(_g("cannot write %s"), "debian/control");
-$fs->lock($lockfh, F_SETLKW) ||
-    syserr(_("failed to get a write lock on %s"), "debian/control");
+file_lock($lockfh, "debian/control");
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y, ">", "$fileslistfile.new") || syserr(_g("open new files list file"));