stop stowing Local:: perl5 libs into HOME

AFAICT pointless complexity.

1 files changed, 88 insertions, 0 deletions

diff --git a/perl5/Local/Util/Git.pm b/perl5/Local/Util/Git.pm
new file mode 100644
index 00000000..55e65eb8
--- /dev/null
+++ b/perl5/Local/Util/Git.pm
@@ -0,0 +1,88 @@
+package Local::Util::Git;
+
+# Copyright (C) 2019 Sean Whitton
+#
+# 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/>.
+
+
+# Probably best if this module has no non-core dependencies.
+
+use strict;
+use warnings;
+
+use Exporter 'import';
+
+our @EXPORT_OK = qw(unpushed_tags);
+
+sub unpushed_tags {
+    my ($dir) = shift;
+
+    my $git = "git";
+    $git .= " -C $dir" if defined $dir;
+
+    # allow skipping this check on a whole repo
+    chomp(my $ignore =
+          `$git config --local --get --type=bool unpushed-tags.ignore`);
+    return () if $ignore eq 'true';
+
+    # archive/debian/foo tags are pushed only to dgit repos in split
+    # brain mode.  Also, it is highly unlikely they don't get pushed
+    # there, so we aren't going to check.  We probably don't want to
+    # ls-remote dgit-repos because that's not really a supported API
+    # (note that dgit doesn't create an origin remote pointing to
+    # dgit-repos anymore)
+    #
+    # We also ignore a debian/foo tag where the corresponding
+    # archive/debian/foo tag exists, because that means the former has
+    # been pushed to dgit repos
+    chomp(my @all_tags = `$git tag`);
+    die "failed to get git tags" unless ($? == 0);
+    my @tags;
+    my %dgit_archive_tags;
+    for (@all_tags) {
+        if (m|^archive/debian/|) {
+            $dgit_archive_tags{$_} = undef;
+        } else {
+            push @tags, $_;
+        }
+    }
+    @tags
+      = grep { !(m|^debian/| and exists $dgit_archive_tags{"archive/$_"}) }
+      @tags;
+
+    chomp(my @remotes = `$git remote`);
+    die "failed to get git remotes" unless ($? == 0);
+    @remotes = grep !/\Adgit\z/, @remotes;
+
+    my %pushed_tags;
+    foreach my $remote (@remotes) {
+        # allow skipping remotes which don't like 'ls-remote'
+        chomp(my $ignore =
+              `$git config --local --get --type=bool remote.$remote.unpushed-tags-ignore`);
+        next if $ignore eq 'true';
+
+        # remotes without URIs are probably git-annex special remotes; skip them
+        `$git config --local --get remote.$remote.url`;
+        next unless $? == 0;
+
+        chomp(my @ls_remote = `$git ls-remote --tags $remote`);
+        die "failed to list git remote $remote" unless ($? == 0);
+        $pushed_tags{$_} = undef
+          for map { m|^[0-9a-f]+\s+refs/tags/([^^]+)|; $1 // () } @ls_remote;
+    }
+
+    return grep { ! exists $pushed_tags{$_} } @tags;
+}
+
+1;