git-remote.perlon commit Pull out remote listing functions in git-remote. (7a8c9ec)
   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(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(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 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
 162sub 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
 195sub 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 (you'd better remove them)\n";
 204                print "    @$stale\n";
 205        }
 206        if (@$tracked) {
 207                print "  Tracked remote branches\n";
 208                print "    @$tracked\n";
 209        }
 210}
 211
 212sub show_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        print "* remote $name\n";
 222        print "  URL: $info->{'URL'}\n";
 223        for my $branchname (sort keys %$branch) {
 224                next if ($branch->{$branchname}{'REMOTE'} ne $name);
 225                my @merged = map {
 226                        s|^refs/heads/||;
 227                        $_;
 228                } split(' ',"@{$branch->{$branchname}{'MERGE'}}");
 229                next unless (@merged);
 230                print "  Remote branch(es) merged with 'git pull' while on branch $branchname\n";
 231                print "    @merged\n";
 232        }
 233        if ($info->{'LS_REMOTE'}) {
 234                show_mapping($name, $info);
 235        }
 236}
 237
 238sub add_remote {
 239        my ($name, $url) = @_;
 240        if (exists $remote->{$name}) {
 241                print STDERR "remote $name already exists.\n";
 242                exit(1);
 243        }
 244        $git->command('config', "remote.$name.url", $url);
 245        $git->command('config', "remote.$name.fetch",
 246                      "+refs/heads/*:refs/remotes/$name/*");
 247}
 248
 249if (!@ARGV) {
 250        for (sort keys %$remote) {
 251                print "$_\n";
 252        }
 253}
 254elsif ($ARGV[0] eq 'show') {
 255        my $ls_remote = 1;
 256        my $i;
 257        for ($i = 1; $i < @ARGV; $i++) {
 258                if ($ARGV[$i] eq '-n') {
 259                        $ls_remote = 0;
 260                }
 261                else {
 262                        last;
 263                }
 264        }
 265        if ($i >= @ARGV) {
 266                print STDERR "Usage: git remote show <remote>\n";
 267                exit(1);
 268        }
 269        for (; $i < @ARGV; $i++) {
 270                show_remote($ARGV[$i], $ls_remote);
 271        }
 272}
 273elsif ($ARGV[0] eq 'add') {
 274        if (@ARGV != 3) {
 275                print STDERR "Usage: git remote add <name> <url>\n";
 276                exit(1);
 277        }
 278        add_remote($ARGV[1], $ARGV[2]);
 279}
 280else {
 281        print STDERR "Usage: git remote\n";
 282        print STDERR "       git remote add <name> <url>\n";
 283        print STDERR "       git remote show <name>\n";
 284        exit(1);
 285}