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 show_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         if (@new) {
 160                 print "  New remote branches (next fetch will store in remotes/$ours)\n";
 161                 print "    @new\n";
 162         }
 163         if (@stale) {
 164                 print "  Stale tracking branches in remotes/$ours (you'd better remove them)\n";
 165                 print "    @stale\n";
 166         }
 167         if (@tracked) {
 168                 print "  Tracked remote branches\n";
 169                 print "    @tracked\n";
 170         }
 171 }
 172
 173 sub show_mapping {
 174         my ($name, $info) = @_;
 175         my $fetch = $info->{'FETCH'};
 176         my $ls = $info->{'LS_REMOTE'};
 177         my (@stale, @tracked);
 178
 179         for (@$fetch) {
 180                 next unless (/(\+)?([^:]+):(.*)/);
 181                 my ($forced, $theirs, $ours) = ($1, $2, $3);
 182                 if ($theirs eq 'refs/heads/*' &&
 183                     $ours =~ /^refs\/remotes\/(.*)\/\*$/) {
 184                         # wildcard mapping
 185                         show_wildcard_mapping($forced, $1, $ls);
 186                 }
 187                 elsif ($theirs =~ /\*/ || $ours =~ /\*/) {
 188                         print STDERR "Warning: unrecognized mapping in remotes.$name.fetch: $_\n";
 189                 }
 190                 elsif ($theirs =~ s|^refs/heads/||) {
 191                         if (!grep { $_ eq $theirs } @$ls) {
 192                                 push @stale, $theirs;
 193                         }
 194                         elsif ($ours ne '') {
 195                                 push @tracked, $theirs;
 196                         }
 197                 }
 198         }
 199         if (@stale) {
 200                 print "  Stale tracking branches in remotes/$name (you'd better remove them)\n";
 201                 print "    @stale\n";
 202         }
 203         if (@tracked) {
 204                 print "  Tracked remote branches\n";
 205                 print "    @tracked\n";
 206         }
 207 }
 208
 209 sub show_remote {
 210         my ($name, $ls_remote) = @_;
 211         if (!exists $remote->{$name}) {
 212                 print STDERR "No such remote $name\n";
 213                 return;
 214         }
 215         my $info = $remote->{$name};
 216         update_ls_remote($ls_remote, $info);
 217
 218         print "* remote $name\n";
 219         print "  URL: $info->{'URL'}\n";
 220         for my $branchname (sort keys %$branch) {
 221                 next if ($branch->{$branchname}{'REMOTE'} ne $name);
 222                 my @merged = map {
 223                         s|^refs/heads/||;
 224                         $_;
 225                 } split(' ',"@{$branch->{$branchname}{'MERGE'}}");
 226                 next unless (@merged);
 227                 print "  Remote branch(es) merged with 'git pull' while on branch $branchname\n";
 228                 print "    @merged\n";
 229         }
 230         if ($info->{'LS_REMOTE'}) {
 231                 show_mapping($name, $info);
 232         }
 233 }
 234
 235 sub add_remote {
 236         my ($name, $url) = @_;
 237         if (exists $remote->{$name}) {
 238                 print STDERR "remote $name already exists.\n";
 239                 exit(1);
 240         }
 241         $git->command('config', "remote.$name.url", $url);
 242         $git->command('config', "remote.$name.fetch",
 243                       "+refs/heads/*:refs/remotes/$name/*");
 244 }
 245
 246 if (!@ARGV) {
 247         for (sort keys %$remote) {
 248                 print "$_\n";
 249         }
 250 }
 251 elsif ($ARGV[0] eq 'show') {
 252         my $ls_remote = 1;
 253         my $i;
 254         for ($i = 1; $i < @ARGV; $i++) {
 255                 if ($ARGV[$i] eq '-n') {
 256                         $ls_remote = 0;
 257                 }
 258                 else {
 259                         last;
 260                 }
 261         }
 262         if ($i >= @ARGV) {
 263                 print STDERR "Usage: git remote show <remote>\n";
 264                 exit(1);
 265         }
 266         for (; $i < @ARGV; $i++) {
 267                 show_remote($ARGV[$i], $ls_remote);
 268         }
 269 }
 270 elsif ($ARGV[0] eq 'add') {
 271         if (@ARGV != 3) {
 272                 print STDERR "Usage: git remote add <name> <url>\n";
 273                 exit(1);
 274         }
 275         add_remote($ARGV[1], $ARGV[2]);
 276 }
 277 else {
 278         print STDERR "Usage: git remote\n";
 279         print STDERR "       git remote add <name> <url>\n";
 280         print STDERR "       git remote show <name>\n";
 281         exit(1);
 282 }