git-remote.perlon commit reflog gc: a tag that does not point at a commit is not a crime. (c9a8992)
   1#!/usr/bin/perl -w
   2
   3use Git;
   4my $git = Git->repository();
   5
   6sub 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
  23sub 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
  63sub list_remote {
  64        my ($git) = @_;
  65        my %seen = ();
  66        my @remotes = eval {
  67                $git->command(qw(repo-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
  88sub 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
 102sub list_branch {
 103        my ($git) = @_;
 104        my %seen = ();
 105        my @branches = eval {
 106                $git->command(qw(repo-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
 117my $remote = list_remote($git);
 118my $branch = list_branch($git);
 119
 120sub 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
 133sub 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
 173sub 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
 209sub 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
 235sub 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('repo-config', "remote.$name.url", $url);
 242        $git->command('repo-config', "remote.$name.fetch",
 243                      "+refs/heads/*:refs/remotes/$name/*");
 244}
 245
 246if (!@ARGV) {
 247        for (sort keys %$remote) {
 248                print "$_\n";
 249        }
 250}
 251elsif ($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}
 270elsif ($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}
 277else {
 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}