1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
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 @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 Ian's script 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);
}
}
}
|
