#!/usr/bin/env perl

# reprepro-rebuilder -- rebuild Debian packages for a local repository

# Copyright (C) 2020-2022  Sean Whitton <spwhitton@spwhitton.name>
#
# 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 3 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 <https://www.gnu.org/licenses/>.

use 5.032;
use strict;
use warnings;
use autodie ":all";

use Cwd;
use File::Basename;
use File::Spec::Functions "catfile", "rel2abs";
use File::Temp "tempdir";
use Array::Utils "array_minus";
use List::Util "uniq";
use Git::Wrapper;
use Getopt::Long;
use Term::UI;
use File::chdir;

our $repo             = "$ENV{HOME}/lib/athena-apt";
our $prefix           = "athena";
our @dists            = qw(bookworm bookworm-backports unstable experimental);
our $bpo_dist         = "bookworm-backports";
our $bpo_dist_num     = 12;
our @crossbuild_archs = ();

my $us = basename $0;

my ($minus, $plus, $release, $build);
GetOptions
  "minus"       => \$minus,
  "plus"        => \$plus,
  "release"     => \$release,
  "wanna-build" => \$build;
$plus or $release or $build or $minus++;
unless (grep($_, $minus, $plus, $release, $build) == 1
    and ($minus || $plus) && @ARGV == 1 || ($release || $build) && !@ARGV) {
    say STDERR "usage:";
    say STDERR "  $us [--minus|--plus] CODENAME|SUITE";
    say STDERR "  $us --release|--wanna-build";
    exit 255;
}
-d $repo or die "$repo doesn't exist?";
my $git = Git::Wrapper->new(getcwd);
$build || $git->RUN("status", { porcelain => 1 }) && die "git commit first\n";
my $term   = Term::ReadLine->new("brand");
my $suffix = $plus ? "+$prefix" : "~$prefix";

if ($minus || $plus) {
    my $codename = shift @ARGV;
    prepare($codename, $suffix);
    $codename eq "unstable" and maybe_bpo();
    maybe_build();
} elsif ($release) {
    release();
    my ($branch) = $git->rev_parse({ abbrev_ref => 1 }, "HEAD");
    $branch eq "$prefix/unstable" and maybe_bpo();
    maybe_build();
} elsif ($build) {
    build();
}

sub maybe_bpo {
    $term->ask_yn(prompt => "Also prepare rebuild for $bpo_dist?")
      and prepare($bpo_dist, $suffix)
}

sub maybe_build {
    $term->ask_yn(prompt => "Populate ${repo}'s binary builds?")
      ? build()
      : say "Okay, say '$us --wanna-build' when you're ready."
}

#### BRANCHING, MERGING, NEW CHANGELOG ENTRIES ####
sub prepare {
    my ($codename, $suffix) = @_;
    my $branch = "$prefix/$codename";

    if ($codename eq $bpo_dist) {
        $suffix = "~bpo$bpo_dist_num+1$suffix";
    } elsif ($codename =~ /-backports$/) {
        die "unknown backports suite $codename";
    }

    my @matching_remote_branches = map { (split)[2] =~ s{^refs/remotes/}{}r }
      grep m{/$branch$}, $git->for_each_ref("refs/remotes/");

    if ($git->for_each_ref("[r]efs/heads/$branch")) {
        my ($current) = $git->rev_parse({ abbrev_ref => 1 }, "HEAD");
        if ($branch eq $current) {
            say STDERR
              "Already on $branch, don't know what you want to rebuild.";
            say STDERR "Maybe you wanted '$us --release' to build a dsc.";
            exit 1;
        } else {
            $git->checkout($branch);
            system "dgit", "setup-mergechangelogs";
            $git->merge($current);
        }
    } elsif (@matching_remote_branches) {
        say STDERR "I want to create branch $branch,"
          . " but these remote branches already exist:";
        say STDERR "  $_" for @matching_remote_branches;
        say STDERR "maybe you want to check out"
          . " or 'git branchmove get' one of those.";
        exit 1;
    } else {
        $git->checkout("-b", $branch);
    }

    system "dch", "-l$suffix", "Rebuild for $prefix apt repository.";
    $git->add("debian/changelog");
    $git->commit({ message => "Rebuild for $prefix apt repository" });

    {
        no autodie;
        $term->ask_yn(prompt => "Build binary package for local testing?")
          and system qw(dgit sbuild --no-run-lintian -A -d), $codename;
    }

    $term->ask_yn(prompt => "Tag release & add dsc to reprepro?")
      ? release(1)
      : say "Okay, say '$us --release' when you're ready.";
}

#### 'dch -r' & ADDING SOURCE PACKAGES TO REPREPRO ####
sub release {
    my $amend = shift // 0;
    my ($branch) = $git->symbolic_ref("HEAD");
    (my $codename = $branch) =~ s{^refs/heads/$prefix/}{};
    chomp(my $dist = `dpkg-parsechangelog -SDistribution`);

    if ($dist eq "UNRELEASED") {
        system "dch", "-D$codename", "-r";
        $git->add("debian/changelog");
        $git->commit({
            amend   => $amend,
            message => $amend
            ? "Rebuild for $prefix apt repository"
            : "Release rebuild to $prefix apt repository"
        });
    } elsif ($dist ne $codename) {
        die "d/changelog has $dist, but branch name indicates $codename\n";
    }

    system "dgit", "build-source";
    system qw(gbp buildpackage --git-tag-only --git-ignore-branch);
    chomp(my $package = `dpkg-parsechangelog -SSource`);
    chomp(my $version = `dpkg-parsechangelog -SVersion`);
    reprepro("includedsc", $codename, rel2abs "../${package}_${version}.dsc");
}

#### POPULATING REPREPRO BINARY PACKAGES ####
sub build {
    my (@succeeded, @failed);
    chomp(my $arch = `dpkg --print-architecture`);

    # Add "Tracking: minimal" for each distribution's stanza in reprepro conf.
    reprepro("retrack", @dists);

    foreach my $dist (@dists) {
        my @all_needed  = dsc2rel(reprepro("build-needing", $dist, "all"));
        my @arch_needed = dsc2rel(reprepro("build-needing", $dist, $arch));
        my %cross_needed = map {
            my @dscs = reprepro("build-needing", $dist, $_);
            @dscs ? ($_, [dsc2rel(@dscs)]) : ()
        } grep $_ ne $arch, @crossbuild_archs;
        next unless @all_needed or @arch_needed or %cross_needed;
        @arch_needed = array_minus @arch_needed, @all_needed;

        my $build_debs = sub {
            my %opts = shift->%*;
            my @args = ("--no-run-lintian", "-d", $dist);
            push @args, $opts{all} ? "--arch-all" : "--no-arch-all";
            for (@_) {
                no autodie;
                my $bn = basename $_;
                if ($opts{cross}) {
                    system "sbuild", @args, "--host=$opts{cross}", $bn;

                    # Many packages aren't crossbuildable.  Fall back to qemu.
                    $? == 0
                      or system "sbuild", @args, "--arch=$opts{cross}", $bn;
                } else {
                    system "sbuild", @args, $bn;
                }
                push @{ $? == 0 ? \@succeeded : \@failed }, "$bn:$opts{desc}";
            }
        };

        local $CWD = $repo;
        my $temp = tempdir CLEANUP => 1;
        system "dcmd", "cp", $_, $temp
          for uniq @all_needed, @arch_needed, map @$_, values %cross_needed;

        local $CWD = $temp;
        $build_debs->({ desc => $arch }, @arch_needed);
        $build_debs->({ desc => "$arch+all", all => 1 }, @all_needed);
        $build_debs->({ desc => $_, cross => $_ }, $cross_needed{$_}->@*)
          for keys %cross_needed;

	# Command may fail if the .deb is already present from another build.
	eval { reprepro("includedeb", $dist, $_) } for <$temp/*.deb>;
    }

    say "successful builds: @succeeded" if @succeeded;
    say "failed builds: @failed"        if @failed;
}

sub dsc2rel { map +(split)[2], @_ }

sub reprepro {
    local $CWD = $repo;
    wantarray ? `reprepro @_` : system "reprepro", @_
}