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 }