Teach 'git remote' how to cleanup stale tracking branches.
[git] / git-remote.perl
1 #!/usr/bin/perl -w
2
3 use Git;
4 my $git = Git->repository();
5
6 sub add_remote_config {
7         my ($hash, $name, $what, $value) = @_;
8         if ($what eq 'url') {
9                 if (exists $hash->{$name}{'URL'}) {
10                         print STDERR "Warning: more than one remote.$name.url\n";
11                 }
12                 $hash->{$name}{'URL'} = $value;
13         }
14         elsif ($what eq 'fetch') {
15                 $hash->{$name}{'FETCH'} ||= [];
16                 push @{$hash->{$name}{'FETCH'}}, $value;
17         }
18         if (!exists $hash->{$name}{'SOURCE'}) {
19                 $hash->{$name}{'SOURCE'} = 'config';
20         }
21 }
22
23 sub add_remote_remotes {
24         my ($hash, $file, $name) = @_;
25
26         if (exists $hash->{$name}) {
27                 $hash->{$name}{'WARNING'} = 'ignored due to config';
28                 return;
29         }
30
31         my $fh;
32         if (!open($fh, '<', $file)) {
33                 print STDERR "Warning: cannot open $file\n";
34                 return;
35         }
36         my $it = { 'SOURCE' => 'remotes' };
37         $hash->{$name} = $it;
38         while (<$fh>) {
39                 chomp;
40                 if (/^URL:\s*(.*)$/) {
41                         # Having more than one is Ok -- it is used for push.
42                         if (! exists $it->{'URL'}) {
43                                 $it->{'URL'} = $1;
44                         }
45                 }
46                 elsif (/^Push:\s*(.*)$/) {
47                         ; # later
48                 }
49                 elsif (/^Pull:\s*(.*)$/) {
50                         $it->{'FETCH'} ||= [];
51                         push @{$it->{'FETCH'}}, $1;
52                 }
53                 elsif (/^\#/) {
54                         ; # ignore
55                 }
56                 else {
57                         print STDERR "Warning: funny line in $file: $_\n";
58                 }
59         }
60         close($fh);
61 }
62
63 sub list_remote {
64         my ($git) = @_;
65         my %seen = ();
66         my @remotes = eval {
67                 $git->command(qw(config --get-regexp), '^remote\.');
68         };
69         for (@remotes) {
70                 if (/^remote\.([^.]*)\.(\S*)\s+(.*)$/) {
71                         add_remote_config(\%seen, $1, $2, $3);
72                 }
73         }
74
75         my $dir = $git->repo_path() . "/remotes";
76         if (opendir(my $dh, $dir)) {
77                 local $_;
78                 while ($_ = readdir($dh)) {
79                         chomp;
80                         next if (! -f "$dir/$_" || ! -r _);
81                         add_remote_remotes(\%seen, "$dir/$_", $_);
82                 }
83         }
84
85         return \%seen;
86 }
87
88 sub add_branch_config {
89         my ($hash, $name, $what, $value) = @_;
90         if ($what eq 'remote') {
91                 if (exists $hash->{$name}{'REMOTE'}) {
92                         print STDERR "Warning: more than one branch.$name.remote\n";
93                 }
94                 $hash->{$name}{'REMOTE'} = $value;
95         }
96         elsif ($what eq 'merge') {
97                 $hash->{$name}{'MERGE'} ||= [];
98                 push @{$hash->{$name}{'MERGE'}}, $value;
99         }
100 }
101
102 sub list_branch {
103         my ($git) = @_;
104         my %seen = ();
105         my @branches = eval {
106                 $git->command(qw(config --get-regexp), '^branch\.');
107         };
108         for (@branches) {
109                 if (/^branch\.([^.]*)\.(\S*)\s+(.*)$/) {
110                         add_branch_config(\%seen, $1, $2, $3);
111                 }
112         }
113
114         return \%seen;
115 }
116
117 my $remote = list_remote($git);
118 my $branch = list_branch($git);
119
120 sub update_ls_remote {
121         my ($harder, $info) = @_;
122
123         return if (($harder == 0) ||
124                    (($harder == 1) && exists $info->{'LS_REMOTE'}));
125
126         my @ref = map {
127                 s|^[0-9a-f]{40}\s+refs/heads/||;
128                 $_;
129         } $git->command(qw(ls-remote --heads), $info->{'URL'});
130         $info->{'LS_REMOTE'} = \@ref;
131 }
132
133 sub list_wildcard_mapping {
134         my ($forced, $ours, $ls) = @_;
135         my %refs;
136         for (@$ls) {
137                 $refs{$_} = 01; # bit #0 to say "they have"
138         }
139         for ($git->command('for-each-ref', "refs/remotes/$ours")) {
140                 chomp;
141                 next unless (s|^[0-9a-f]{40}\s[a-z]+\srefs/remotes/$ours/||);
142                 next if ($_ eq 'HEAD');
143                 $refs{$_} ||= 0;
144                 $refs{$_} |= 02; # bit #1 to say "we have"
145         }
146         my (@new, @stale, @tracked);
147         for (sort keys %refs) {
148                 my $have = $refs{$_};
149                 if ($have == 1) {
150                         push @new, $_;
151                 }
152                 elsif ($have == 2) {
153                         push @stale, $_;
154                 }
155                 elsif ($have == 3) {
156                         push @tracked, $_;
157                 }
158         }
159         return \@new, \@stale, \@tracked;
160 }
161
162 sub list_mapping {
163         my ($name, $info) = @_;
164         my $fetch = $info->{'FETCH'};
165         my $ls = $info->{'LS_REMOTE'};
166         my (@new, @stale, @tracked);
167
168         for (@$fetch) {
169                 next unless (/(\+)?([^:]+):(.*)/);
170                 my ($forced, $theirs, $ours) = ($1, $2, $3);
171                 if ($theirs eq 'refs/heads/*' &&
172                     $ours =~ /^refs\/remotes\/(.*)\/\*$/) {
173                         # wildcard mapping
174                         my ($w_new, $w_stale, $w_tracked)
175                                 = list_wildcard_mapping($forced, $1, $ls);
176                         push @new, @$w_new;
177                         push @stale, @$w_stale;
178                         push @tracked, @$w_tracked;
179                 }
180                 elsif ($theirs =~ /\*/ || $ours =~ /\*/) {
181                         print STDERR "Warning: unrecognized mapping in remotes.$name.fetch: $_\n";
182                 }
183                 elsif ($theirs =~ s|^refs/heads/||) {
184                         if (!grep { $_ eq $theirs } @$ls) {
185                                 push @stale, $theirs;
186                         }
187                         elsif ($ours ne '') {
188                                 push @tracked, $theirs;
189                         }
190                 }
191         }
192         return \@new, \@stale, \@tracked;
193 }
194
195 sub show_mapping {
196         my ($name, $info) = @_;
197         my ($new, $stale, $tracked) = list_mapping($name, $info);
198         if (@$new) {
199                 print "  New remote branches (next fetch will store in remotes/$name)\n";
200                 print "    @$new\n";
201         }
202         if (@$stale) {
203                 print "  Stale tracking branches in remotes/$name (use 'git remote prune')\n";
204                 print "    @$stale\n";
205         }
206         if (@$tracked) {
207                 print "  Tracked remote branches\n";
208                 print "    @$tracked\n";
209         }
210 }
211
212 sub prune_remote {
213         my ($name, $ls_remote) = @_;
214         if (!exists $remote->{$name}) {
215                 print STDERR "No such remote $name\n";
216                 return;
217         }
218         my $info = $remote->{$name};
219         update_ls_remote($ls_remote, $info);
220
221         my ($new, $stale, $tracked) = list_mapping($name, $info);
222         my $prefix = "refs/remotes/$name";
223         foreach my $to_prune (@$stale) {
224                 my @v = $git->command(qw(rev-parse --verify), "$prefix/$to_prune");
225                 $git->command(qw(update-ref -d), "$prefix/$to_prune", $v[0]);
226         }
227 }
228
229 sub show_remote {
230         my ($name, $ls_remote) = @_;
231         if (!exists $remote->{$name}) {
232                 print STDERR "No such remote $name\n";
233                 return;
234         }
235         my $info = $remote->{$name};
236         update_ls_remote($ls_remote, $info);
237
238         print "* remote $name\n";
239         print "  URL: $info->{'URL'}\n";
240         for my $branchname (sort keys %$branch) {
241                 next if ($branch->{$branchname}{'REMOTE'} ne $name);
242                 my @merged = map {
243                         s|^refs/heads/||;
244                         $_;
245                 } split(' ',"@{$branch->{$branchname}{'MERGE'}}");
246                 next unless (@merged);
247                 print "  Remote branch(es) merged with 'git pull' while on branch $branchname\n";
248                 print "    @merged\n";
249         }
250         if ($info->{'LS_REMOTE'}) {
251                 show_mapping($name, $info);
252         }
253 }
254
255 sub add_remote {
256         my ($name, $url) = @_;
257         if (exists $remote->{$name}) {
258                 print STDERR "remote $name already exists.\n";
259                 exit(1);
260         }
261         $git->command('config', "remote.$name.url", $url);
262         $git->command('config', "remote.$name.fetch",
263                       "+refs/heads/*:refs/remotes/$name/*");
264 }
265
266 if (!@ARGV) {
267         for (sort keys %$remote) {
268                 print "$_\n";
269         }
270 }
271 elsif ($ARGV[0] eq 'show') {
272         my $ls_remote = 1;
273         my $i;
274         for ($i = 1; $i < @ARGV; $i++) {
275                 if ($ARGV[$i] eq '-n') {
276                         $ls_remote = 0;
277                 }
278                 else {
279                         last;
280                 }
281         }
282         if ($i >= @ARGV) {
283                 print STDERR "Usage: git remote show <remote>\n";
284                 exit(1);
285         }
286         for (; $i < @ARGV; $i++) {
287                 show_remote($ARGV[$i], $ls_remote);
288         }
289 }
290 elsif ($ARGV[0] eq 'prune') {
291         my $ls_remote = 1;
292         my $i;
293         for ($i = 1; $i < @ARGV; $i++) {
294                 if ($ARGV[$i] eq '-n') {
295                         $ls_remote = 0;
296                 }
297                 else {
298                         last;
299                 }
300         }
301         if ($i >= @ARGV) {
302                 print STDERR "Usage: git remote prune <remote>\n";
303                 exit(1);
304         }
305         for (; $i < @ARGV; $i++) {
306                 prune_remote($ARGV[$i], $ls_remote);
307         }
308 }
309 elsif ($ARGV[0] eq 'add') {
310         if (@ARGV != 3) {
311                 print STDERR "Usage: git remote add <name> <url>\n";
312                 exit(1);
313         }
314         add_remote($ARGV[1], $ARGV[2]);
315 }
316 else {
317         print STDERR "Usage: git remote\n";
318         print STDERR "       git remote add <name> <url>\n";
319         print STDERR "       git remote show <name>\n";
320         print STDERR "       git remote prune <name>\n";
321         exit(1);
322 }