scripts/git-branchmove

   1 #!/usr/bin/perl
   2
   3 # git-branchmove -- move branches to or from a remote
   4
   5 # Copyright (C) 2019 Sean Whitton
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or (at
  10 # your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 # This script is based on Ian Jackson's git-branchmove script, in the
  21 # chiark-utils Debian source package.  Ian's script assumes throughout
  22 # that it is possible to have unrestricted shell access to the remote,
  23 # however, while this script avoids that global assumption.
  24 #
  25 # As much as possible we treat the remote argument as opaque, i.e., we
  26 # don't distinguish between git URIs and named remotes.  That means
  27 # that git will expand insteadOf and pushInsteadOf user config for us.
  28
  29 =head1 NAME
  30
  31 git-branchmove - move branches to or from a remote
  32
  33 =head1 SYNOPSIS
  34
  35 B<git-branchmove> [B<--detach>|B<-d>] B<get>|B<put> I<remote> I<pattern>...
  36
  37 =head1 DESCRIPTION
  38
  39 Move branches matching I<pattern> to or from git remote I<remote>.
  40
  41 =head1 OPTIONS
  42
  43 =over 4
  44
  45 =item B<--detach>|B<-d>
  46
  47 If the move would delete the currently checked out branch in the
  48 source repository, attempt to detach HEAD first.
  49
  50 Note that in the case of the B<get> operation, the attempt to detach
  51 HEAD is somewhat fragile.  You will need unrestricted SSH access to
  52 the remote, and pushInsteadOf git configuration keys will not always
  53 be expanded, due to limitations in git.
  54
  55 =back
  56
  57 =head1 AUTHOR
  58
  59 This Perl version of B<git-branchmove> was written by Sean Whitton
  60 <spwhitton@spwhitton.name>, based on an earlier shell script by Ian
  61 Jackson.  That script made some assumptions that we try to avoid, for
  62 compatibility with more git remotes and local git configurations.
  63
  64 =cut
  65
  66 use strict;
  67 use warnings;
  68
  69 use Git::Wrapper;
  70 use Try::Tiny;
  71
  72 # git wrapper setup
  73 my $git = Git::Wrapper->new(".");
  74 try {
  75     $git->rev_parse({ git_dir => 1 });
  76 } catch {
  77     die "git-branchmove: pwd doesn't look like a git repository ..\n";
  78 };
  79
  80 # process arguments
  81 die "git-branchmove: not enough arguments\n" if @ARGV < 3;
  82 my $attempt_detach = 0;
  83 if ($ARGV[0] eq '-d' or $ARGV[0] eq '--detach') {
  84     $attempt_detach = 1;
  85     shift @ARGV;
  86 }
  87 my ($op, $remote, @patterns) = @ARGV;
  88 die "git-branchmove: unknown operation\n"
  89   unless $op eq 'get' or $op eq 'put';
  90
  91 # is this a named remote or a git URL?  See "GIT URLS" in git-fetch(1)
  92 my $named_remote = not($remote =~ m|:| or $remote =~ m|^[/.]|);
  93
  94 # Attempt to determine how we might be able to run commands in the
  95 # remote repo.  This will only be used if we need to try to detach the
  96 # remote HEAD.  These regexps are lifted from Ian's version of
  97 # git-branchmove
  98 my ($rurl, $rrune, $rdir);
  99 if ($named_remote) {
 100     # this will expand insteadOf and pushInsteadOf
 101     ($rurl) = $git->remote("get-url", "--push", $remote);
 102 } else {
 103     # this will expand insteadOf but not pushInsteadOf, which is the
 104     # best we can do; see <https://stackoverflow.com/a/32991784>
 105     ($rurl) = $git->ls_remote("--get-url", $remote);
 106 }
 107 if ($rurl =~ m#^ssh://([^:/]+)(?:\:(\w+))?#) {
 108     $rdir  = $';
 109     $rrune = "ssh ";
 110     $rrune .= "-p $2 " if $2;
 111     $rrune .= $1;
 112 } elsif ($rurl =~ m#^([-+_.0-9a-zA-Z\@]+):(?!//|:)#) {
 113     $rdir  = $';
 114     $rrune = "ssh $1";
 115 } elsif ($rurl =~ m#^[/.]#) {
 116     $rdir = $rurl;
 117 }
 118
 119 # If we don't prefix the patterns, we might match branches the user
 120 # doesn't intend.  E.g. 'foo' would match 'wip/foo'
 121 my @branch_pats = map { s|^|[r]efs/heads/|r } @patterns;
 122
 123 # get lists of branches, prefixed with 'refs/heads/' in each case
 124 my (@source_branches, @dest_branches);
 125 my @local_branches = map {
 126     my ($hash, undef, $ref) = split ' ';
 127     { hash => $hash, ref => $ref }
 128 } $git->for_each_ref(@branch_pats);
 129 my @remote_branches = map {
 130     my ($hash, $ref) = split ' ';
 131     { hash => $hash, ref => $ref }
 132 } $git->ls_remote($remote, @branch_pats);
 133 if ($op eq 'put') {
 134     @source_branches = @local_branches;
 135     @dest_branches   = @remote_branches;
 136 } elsif ($op eq 'get') {
 137     @source_branches = @remote_branches;
 138     @dest_branches   = @local_branches;
 139 }
 140
 141 # do we have anything to move?
 142 die "git-branchmove: nothing to do\n" unless @source_branches;
 143
 144 # check for deleting the current branch on the source
 145 my $source_head;
 146 if ($op eq "put") {
 147     my @lines = try { $git->symbolic_ref('-q', 'HEAD') };
 148     $source_head = $lines[0] if @lines;    # the HEAD is not detached
 149 } elsif ($op eq "get") {
 150     my @lines = try { $git->ls_remote('--symref', $remote, 'HEAD') };
 151     if (@lines and $lines[0] =~ m|^ref: refs/heads/|) {
 152         # the HEAD is not detached
 153         (undef, $source_head) = split ' ', $lines[0];
 154     }
 155 }
 156 if (defined $source_head and grep /^\Q$source_head\E$/,
 157     map { $_->{ref} } @source_branches) {
 158     if ($attempt_detach) {
 159         if ($op eq 'put') {
 160             $git->checkout('--detach');
 161         } elsif ($op eq 'get') {
 162             if (defined $rrune and defined $rdir) {
 163                 system "$rrune \"set -e; cd $rdir; git checkout --detach\"";
 164                 die "failed to detach remote HEAD" unless $? eq 0;
 165             } elsif (!defined $rrune and defined $rdir) {
 166                 my $dest_git = Git::Wrapper->new($rdir);
 167                 $dest_git->checkout('--detach');
 168             } else {
 169                 die "git-branchmove: don't know how to detach remote HEAD";
 170             }
 171         }
 172     } else {
 173         die "git-branchmove: would delete checked-out branch $source_head\n";
 174     }
 175 }
 176
 177 # check whether we would overwrite anything
 178 foreach my $source_branch (@source_branches) {
 179     foreach my $dest_branch (@dest_branches) {
 180         die "git-branchmove: would overwrite $source_branch->{ref}"
 181           if (  $source_branch->{ref} eq $dest_branch->{ref}
 182             and $source_branch->{hash} ne $dest_branch->{hash});
 183     }
 184 }
 185
 186 # time to actually move the branches
 187 my @refspecs      = map { "$_->{ref}:$_->{ref}" } @source_branches;
 188 my @nuke_refspecs = map { ":$_->{ref}" } @source_branches;
 189 if ($op eq 'put') {
 190     $git->push('--no-follow-tags', $remote, @refspecs);
 191     $git->update_ref('-m', "git-branchmove: moved to $remote ($rurl)",
 192         '-d', $_->{ref}, $_->{hash})
 193       for @source_branches;
 194 } elsif ($op eq 'get') {
 195     $git->fetch('--no-tags', $remote, @refspecs);
 196     $git->push('--no-follow-tags', $remote, @nuke_refspecs);
 197 }
 198
 199 # if the remote is a named remote, rather than just a URI, update
 200 # remote-tracking branches
 201 if ($named_remote) {
 202     foreach my $source_branch (@source_branches) {
 203         my $branch       = $source_branch->{ref} =~ s|^refs/heads/||r;
 204         my $tracking_ref = "refs/remotes/$remote/$branch";
 205         if ($op eq 'put') {
 206             $git->update_ref($tracking_ref, $source_branch->{hash});
 207         } elsif ($op eq 'get') {
 208             $git->update_ref('-d', $tracking_ref);
 209         }
 210     }
 211 }