#!/usr/bin/perl

# git-deborig -- try to produce Debian orig.tar using git-archive(1)

# Copyright (C) 2016-2019, 2025  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 <http://www.gnu.org/licenses/>.

use Debian::Dgit::GDP;

use strict;
use warnings;

use Getopt::Long;
use Debian::Dgit::Core;
use Dpkg::Changelog::Parse;
use Dpkg::IPC;
use Dpkg::Version;

# Sanity check #1
(cmdoutput_errok qw(git rev-parse --git-dir))
  // die "pwd doesn't look like a git repository ..\n";

# Sanity check #2
die "pwd doesn't look like a Debian source package ..\n"
  unless -e "debian/changelog";

# Process command line args
my $orig_args = shellquote qw(git deborig), @ARGV;
my ($overwrite, $user_version, $user_ref, $just_print, $just_print_tag_names);
GetOptions(
    'force|f'              => \$overwrite,
    'just-print'           => \$just_print,
    'just-print-tag-names' => \$just_print_tag_names,
    'version=s'            => \$user_version
) || usage();

if (@ARGV == 1) {
    $user_ref = shift @ARGV;
} elsif (@ARGV >= 2 || $just_print && $just_print_tag_names) {
    usage();
}

# Extract source package name from d/changelog and either extract
# version too, or parse user-supplied version
my $changelog = Dpkg::Changelog::Parse->changelog_parse({});
my $version = $user_version
  ? Dpkg::Version->new($user_version)
  : $changelog->{Version};

# Sanity check #3
die "version number $version is not valid ..\n" unless $version->is_valid;

my $source           = $changelog->{Source};
my $upstream_version = $version->version;

# Sanity check #4
# Only complain if the user didn't supply a version, because the user
# is not required to include a Debian revision when they pass
# --version
die "this looks like a native package ..\n"
  if !$user_version && $version->is_native;

# Convert the upstream version according to DEP-14 rules
my $git_upstream_version = $upstream_version;
$git_upstream_version =~ y/:~/%_/;
$git_upstream_version =~ s/\.(?=\.|$|lock$)/.#/g;

# This list could be expanded if new conventions come into use
my @candidate_tags = (
    "$git_upstream_version", "v$git_upstream_version",
    "upstream/$git_upstream_version"
);

# Handle the --just-print-tag-names option
if ($just_print_tag_names) {
    print "$_\n" for @candidate_tags;
    exit 0;
}

# Default to gzip
my $compressor  = "gzip -cn";
my $compression = "gz";
# Now check if we can use xz
if (-e "debian/source/format") {
    open my $format_fh, "<debian/source/format"
      or die "couldn't open debian/source/format for reading";
    my $format = <$format_fh>;
    chomp($format) if defined $format;
    if ($format eq "3.0 (quilt)") {
        $compressor  = "xz -c";
        $compression = "xz";
    }
    close $format_fh;
}

my $orig = "../${source}_$upstream_version.orig.tar.$compression";
die "$orig already exists: not overwriting without --force\n"
  if -e $orig && !$overwrite && !$just_print;

if ($user_ref) {    # User told us the tag/branch to archive
     # We leave it to git-archive(1) to determine whether or not this
     # ref exists; this keeps us forward-compatible
    archive_ref_or_just_print($user_ref);
} else {    # User didn't specify a tag/branch to archive
            # Get available git tags
    my %all_tags;
    git_for_each_ref("refs/tags", sub {
	$_[2] =~ m#^refs/tags/#; $all_tags{$'}++;
    });

    # See which candidate version tags are present in the repo
    my @version_tags = grep $all_tags{$_}, @candidate_tags;

    # If there is only one candidate version tag, we're good to go.
    # Otherwise, let the user know they can tell us which one to use
    if (@version_tags > 1) {
        print STDERR "tags ", join(", ", @version_tags),
          " all exist in this repository\n";
        print STDERR
"tell me which one you want to make an orig.tar from: $orig_args TAG\n";
        exit 1;
    } elsif (@version_tags < 1) {
        print STDERR "couldn't find any of the following tags: ",
          join(", ", @candidate_tags), "\n";
        print STDERR
"tell me a tag or branch head to make an orig.tar from: $orig_args COMMITTISH\n";
        exit 1;
    } else {
        archive_ref_or_just_print(shift @version_tags);
    }
}

sub archive_ref_or_just_print {
    my $ref = shift;

    my $cmd = [
        'git',     '-c', "tar.tar.${compression}.command=${compressor}",
        'archive', "--prefix=${source}-${upstream_version}/",
        '-o',      $orig, $ref
    ];
    if ($just_print) {
        print "$ref\n";
        print "$orig\n";
        print shellquote(@$cmd)."\n";
    } else {
        my $info_dir = cmdoutput qw(git rev-parse --git-path info/);
        my $info_attributes
          = cmdoutput qw(git rev-parse --git-path info/attributes);
        my $deborig_attributes
          = cmdoutput qw(git rev-parse --git-path info/attributes-deborig);

        # sometimes the info/ dir may not exist
        -e or mkdir for $info_dir;

        # For compatibility with dgit, we have to override any
        # export-subst and export-ignore git attributes that might be set
        rename $info_attributes, $deborig_attributes if -e $info_attributes;
        my $attributes_fh;
        unless (open $attributes_fh, ">", $info_attributes) {
            rename $deborig_attributes, $info_attributes
              if -e $deborig_attributes;
            die "could not open $info_attributes for writing";
        }
        print $attributes_fh "* -export-subst\n";
        print $attributes_fh "* -export-ignore\n";
        close $attributes_fh;

        spawn(
            exec       => $cmd,
            wait_child => 1,
            nocheck    => 1
        );

        # Restore situation before we messed around with git attributes
        if (-e $deborig_attributes) {
            rename $deborig_attributes, $info_attributes;
        } else {
            unlink $info_attributes;
        }
    }
}

sub usage {
    die
"usage: git deborig [--force|-f] [--just-print|--just-print-tag-names] [--version=VERSION] [COMMITTISH]\n";
}
