Adding upstream version 2.23.7.upstream/2.23.7upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 284 insertions, 0 deletions

diff --git a/scripts/git-deborig.pl b/scripts/git-deborig.pl
new file mode 100755
index 0000000..7ef342f
--- /dev/null
+++ b/scripts/git-deborig.pl
@@ -0,0 +1,284 @@
+#!/usr/bin/perl
+
+# git-deborig -- try to produce Debian orig.tar using git-archive(1)
+
+# Copyright (C) 2016-2019  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/>.
+
+=head1 NAME
+
+git-deborig - try to produce Debian orig.tar using git-archive(1)
+
+=head1 SYNOPSIS
+
+B<git deborig> [B<--force>|B<-f>] [B<--just-print>|B<--just-print-tag-names>] [B<--version=>I<VERSION>] [I<COMMITTISH>]
+
+=head1 DESCRIPTION
+
+B<git-deborig> tries to produce the orig.tar you need for your upload
+by calling git-archive(1) on an existing git tag or branch head.  It
+was written with the dgit-maint-merge(7) workflow in mind, but can be
+used with other workflows.
+
+B<git-deborig> will try several common tag names.  If this fails, or
+if more than one of those common tags are present, you can specify the
+tag or branch head to archive on the command line (I<COMMITTISH> above).
+
+B<git-deborig> will override gitattributes(5) that would cause the
+contents of the tarball generated by git-archive(1) not to be
+identical with the commitish archived: the B<export-subst> and
+B<export-ignore> attributes.
+
+B<git-deborig> should be invoked from the root of the git repository,
+which should contain I<debian/changelog>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-f>|B<--force>
+
+Overwrite any existing orig.tar in the parent directory.
+
+=item B<--just-print>
+
+Instead of actually invoking git-archive(1), output information about
+how it would be invoked.  Ignores I<--force>.
+
+Note that running the git-archive(1) invocation outputted with this
+option may not produce the same output.  This is because
+B<git-deborig> takes care to disables git attributes otherwise heeded
+by git-archive(1), as detailed above.
+
+=item B<--just-print-tag-names>
+
+Instead of actually invoking git-archive(1), or even checking which
+tags exist, print the tag names we would consider for the upstream
+version number in the first entry in the Debian changelog, or that
+supplied with B<--version>.
+
+=item B<--version=>I<VERSION>
+
+Instead of reading the new upstream version from the first entry in
+the Debian changelog, use I<VERSION>.
+
+=back
+
+=head1 SEE ALSO
+
+git-archive(1), dgit-maint-merge(7), dgit-maint-debrebase(7)
+
+=head1 AUTHOR
+
+B<git-deborig> was written by Sean Whitton <spwhitton@spwhitton.name>.
+
+=cut
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use Git::Wrapper;
+use Dpkg::Changelog::Parse;
+use Dpkg::IPC;
+use Dpkg::Version;
+use List::Compare;
+use String::ShellQuote;
+use Try::Tiny;
+
+my $git = Git::Wrapper->new(".");
+
+# Sanity check #1
+try {
+    $git->rev_parse({ git_dir => 1 });
+} catch {
+    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 = join(" ", map { shell_quote($_) } ("git", "deborig", @ARGV));
+my $overwrite = '';
+my $user_version         = '';
+my $user_ref             = '';
+my $just_print           = '';
+my $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 (scalar @ARGV == 1) {
+    $user_ref = shift @ARGV;
+} elsif (scalar @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 $version;
+my $changelog = Dpkg::Changelog::Parse->changelog_parse({});
+if ($user_version) {
+    $version = Dpkg::Version->new($user_version);
+} else {
+    $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 .."
+  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) {
+    for my $candidate_tag (@candidate_tags) {
+        print "$candidate_tag\n";
+    }
+    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->tag();
+
+    # See which candidate version tags are present in the repo
+    my $lc           = List::Compare->new(\@all_tags, \@candidate_tags);
+    my @version_tags = $lc->get_intersection();
+
+    # 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 (scalar @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 (scalar @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 {
+        my $tag = shift @version_tags;
+        archive_ref_or_just_print($tag);
+    }
+}
+
+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";
+        my @cmd_mapped = map { shell_quote($_) } @$cmd;
+        print "@cmd_mapped\n";
+    } else {
+        my ($info_dir) = $git->rev_parse(qw|--git-path info/|);
+        my ($info_attributes)
+          = $git->rev_parse(qw|--git-path info/attributes|);
+        my ($deborig_attributes)
+          = $git->rev_parse(qw|--git-path info/attributes-deborig|);
+
+        # sometimes the info/ dir may not exist
+        mkdir $info_dir unless (-e $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";
+}