don't use a different name for my script

I'm afraid I'm going to continually invoke the script in /usr/bin
instead of mine.

1 files changed, 131 insertions, 0 deletions

diff --git a/bin/git-branchmove b/bin/git-branchmove
new file mode 100755
index 00000000..560d9c0f
--- /dev/null
+++ b/bin/git-branchmove
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+
+# git-branchmove -- move a branch to or from a remote
+
+# 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/>.
+
+# This script is based on Ian Jackson's git-branchmove script, in the
+# chiark-utils Debian source package.  Ian's script assumes throughout
+# that it is possible to have unrestricted shell access to the remote,
+# however, while this script avoids that assumption.
+#
+# As much as possible we treat the remote argument as opaque, i.e., we
+# don't distinguish between git URIs and named remotes.  That means
+# that git will expand insteadOf and pushInsteadOf user config for us.
+# Some information on the difficulties of getting git to expand these:
+# <https://stackoverflow.com/a/32991784>
+
+use strict;
+use warnings;
+
+use Git::Wrapper;
+use Try::Tiny;
+
+# git wrapper setup
+my $git = Git::Wrapper->new(".");
+try {
+    $git->rev_parse({ git_dir => 1 });
+} catch {
+    die "git-branchmove: pwd doesn't look like a git repository ..\n";
+};
+
+# process arguments
+die "git-branchmove: not enough arguments\n"
+  if (scalar @ARGV < 3);
+my ($op, $remote, @patterns) = @ARGV;
+die "git-branchmove: unknown operation\n"
+  unless ($op eq 'get' or $op eq 'put');
+
+# If we don't prefix the patterns, we might match branches the user
+# doesn't intend.  E.g. 'foo' would match 'wip/foo'
+my @branch_pats = map { $_ =~ s|^|[r]efs/heads/|; $_ } @patterns;
+
+# get lists of branches, prefixed with 'refs/heads/' in each case
+my @source_branches, my @dest_branches, my $update_msg;
+my @local_branches = map {
+    my ($hash, undef, $ref) = split(/\s/, $_);
+    { hash => $hash, ref => $ref }
+} $git->for_each_ref(@branch_pats);
+my @remote_branches = map {
+    my ($hash, $ref) = split(/\s/, $_);
+    { hash => $hash, ref => $ref }
+} $git->ls_remote($remote, @branch_pats);
+if ($op eq 'put') {
+    @source_branches = @local_branches;
+    @dest_branches = @remote_branches;
+} elsif ($op eq 'get') {
+    @source_branches = @remote_branches;
+    @dest_branches = @local_branches;
+}
+
+# do we have anything to move?
+die "git-branchmove: nothing to do" unless (@source_branches);
+
+# check for deleting the current branch on the source
+my $source_head = undef;
+if ($op eq "put") {
+    my @lines = try { $git->symbolic_ref('-q', 'HEAD') };
+    if (@lines) {
+        # the HEAD is not detached
+        $source_head = $lines[0];
+    }
+} elsif ($op eq "get") {
+    my @lines = try { $git->ls_remote('--symref', $remote, 'HEAD') };
+    if (@lines and $lines[0] =~ m|^ref: refs/heads/|) {
+        # the HEAD is not detached
+        $source_head = (split /\s/, $lines[0])[1];
+    }
+}
+die "git-branchmove: would delete checked-out branch $source_head"
+  if (defined $source_head and
+      grep /^$source_head$/, map {$_->{ref}} @source_branches);
+
+# check whether we would overwrite anything
+foreach my $source_branch (@source_branches) {
+    foreach my $dest_branch (@dest_branches) {
+        die "git-branchmove: would overwrite $source_branch->{ref}"
+          if ($source_branch->{ref} eq $dest_branch->{ref}
+              and $source_branch->{hash} ne $dest_branch->{hash})
+    }
+}
+
+# time to actually move the branches
+my @refspecs = map { my $ref = $_->{ref}; "$ref:$ref" } @source_branches;
+my @nuke_refspecs = map { my $ref = $_->{ref}; ":$ref" } @source_branches;
+if ($op eq 'put') {
+    $git->push('--no-follow-tags', $remote, @refspecs);
+    foreach my $source_branch (@source_branches) {
+        # TODO pass a -m argument to update-ref as git-branchmove does
+        $git->update_ref('-d', $source_branch->{ref}, $source_branch->{hash});
+    }
+} elsif ($op eq 'get') {
+    $git->fetch('--no-tags', $remote, @refspecs);
+    $git->push('--no-follow-tags', $remote, @nuke_refspecs)
+}
+
+# if the remote is a named remote, rather than just a URI, update
+# remote-tracking branches
+unless ($remote =~ m|:| or $remote =~ m|^[/.]|) {
+    foreach my $source_branch (@source_branches) {
+        my $branch = $source_branch->{ref} =~ s|^refs/heads/||r;
+        my $tracking_ref = "refs/remotes/$remote/$branch";
+        if ($op eq 'put') {
+            $git->update_ref($tracking_ref, $source_branch->{hash});
+        } elsif ($op eq 'get') {
+            $git->update_ref('-d', $tracking_ref);
+        }
+    }
+}