Bug#841145: dh-golang: Rewrite of dh_golang for a more robust and idiomatic perl

[Guillem Jover]

Package: dh-golang
Version: 1.19
Severity: wishlist
Tags: patch

Hi!

I was taking a look at dh_golang the other day, and thought the code
could do with some rewrite to make it more idiomatic, more robust,
generate command output on DH_VERBOSE, and avoid the need for so many
temporary files (which TBH was what first caught my eye). So I rewrote
it. :)

I've tested building acmetool, before and after the changes and it
produces bit-for-bit idential .deb packages.

Thanks,
Guillem

From ee2c88f79ee2946d69eb9205fdd925605bc6839b Mon Sep 17 00:00:00 2001
From: Guillem Jover <guil...@debian.org>
Date: Tue, 18 Oct 2016 03:06:08 +0200
Subject: [PATCH] Rewrite dh_golang to be more idiomatic perl

The new code does not make use of temporary files anymore, is more
resilient against dpkg output, and should be a bit more idiomatic.
---
 script/dh_golang | 73 +++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 43 insertions(+), 30 deletions(-)

diff --git a/script/dh_golang b/script/dh_golang
index 4c4e09d..097550b 100755
--- a/script/dh_golang
+++ b/script/dh_golang
@@ -10,8 +10,6 @@ use strict;
 use Cwd qw(realpath);
 use Debian::Debhelper::Dh_Lib; # not in core
 use Debian::Debhelper::Dh_Buildsystems; # not in core
-use File::Temp qw(tempdir);
-use File::Path qw(rmtree);
 
 =head1 SYNOPSIS
 
@@ -30,6 +28,39 @@ The best way to invoke B<dh_golang> is by using B<dh --with=golang>.
 
 =cut
 
+sub uniq {
+    my %list = map { $_ => 1 } @_;
+
+    return sort keys %list;
+}
+
+sub exec_single {
+    my ($cmd, @args) = @_;
+
+    verbose_print(escape_shell(@_));
+
+    my @output = qx($cmd @args);
+    error_exitcode($cmd) if $? != 0;
+    chomp(@output);
+
+    return @output;
+}
+
+# Amount of chunking we are going to use for dpkg commands, which should speed
+# up the execution by avoiding too many database loads.
+use constant CHUNKSIZE => 200;
+
+sub exec_chunked {
+    my ($cmd, @list) = @_;
+
+    my @result;
+    for (my $i = 0; $i < @list; $i += CHUNKSIZE) {
+        push @result, exec_single($cmd, @list[$i .. $i + CHUNKSIZE - 1]);
+    }
+
+    return @result;
+}
+
 ############################################################################
 # Generate misc:Built-Using substvar.
 ############################################################################
@@ -43,44 +74,26 @@ my @targets = $bs->get_targets();
 
 my $tmpl = '{{ range .Deps }}{{.}}
 {{ end }}';
-
-my $tmpdir = tempdir("dh_golang_XXXXXXX", TMPDIR => 1);
-
-system("go list -f \"$tmpl\" @targets > $tmpdir/godeps") == 0
-    or die "go list of targets failed with code $?, $!";
+my @godeps = exec_single(qq{go list -f '$tmpl'}, @targets);
 
 my $gofiletmpl = '\
 {{ .Dir }}/{{ index (or .GoFiles .CgoFiles .TestGoFiles .XTestGoFiles .IgnoredGoFiles) 0 }}';
+my @gofiles = exec_chunked(qq{go list -f '$gofiletmpl'}, uniq(@godeps));
 
-system("sort -u $tmpdir/godeps | xargs go list -f '$gofiletmpl' > $tmpdir/gofiles") == 0
-    or die "go list of dependencies failed with code $?, $!";
-
-open(my $inp, "<", "$tmpdir/gofiles");
-open(my $outp, ">", "$tmpdir/realgofiles");
-while (<$inp>) {
-    chomp;
-    my $realpath = realpath($_);
+my @realpath;
+foreach my $pathname (@gofiles) {
+    my $realpath = realpath($pathname);
     # gofiles will include packages being built, so exclude those.
     if ($realpath !~ /^\Q$bs->{cwd}\E/) {
-        printf $outp "%s\n", $realpath;
+        push @realpath, $realpath;
     }
 }
-close($inp);
-close($outp);
-
-system("cat $tmpdir/realgofiles | xargs -r dpkg-query --search > $tmpdir/pkgs") == 0
-    or die "dpkg-query --search failed with code $?, $!";
-
-system("cut -d: -f1 $tmpdir/pkgs | sort -u | xargs -r dpkg-query -f='\${source:Package} (= \${source:Version})\n' -W > $tmpdir/srcpkgs");
-if ($? != 0) {
-    die "dpkg-query -W failed with code $?, $!";
-}
-
-my $built_using = `cat $tmpdir/srcpkgs | sort -u`;
 
-$built_using =~ s/\n/, /g;
+my @searchoutput = exec_chunked('dpkg-query --search', @realpath);
+my @gopkgs = split /, */, join ', ', map { s/: .+$//r } @searchoutput;
 
-rmtree($tmpdir);
+my @srcdeps = exec_chunked(q{dpkg-query -f='${source:Package} (= ${source:Version})\n' -W}, uniq(@gopkgs));
+my $built_using = join ', ', uniq(@srcdeps);
 
 # If there is an easier way to have a universal misc:Built-Using on all binary
 # packages, I am happy to merge your patch :).
-- 
2.9.3