sync-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Cwd;
   5
   6 # Figure out where to get the other repositories from,
   7 # based on where this GHC repo came from.
   8 my $branch = `git branch | grep "\* " | sed "s/^\* //"`; chomp $branch;
   9 my $remote = `git config branch.$branch.remote`;         chomp $remote;
  10 my $defaultrepo = `git config remote.$remote.url`;       chomp $defaultrepo;
  11
  12 my $defaultrepo_base;
  13 my $checked_out_tree;
  14
  15 if ($defaultrepo =~ /^...*:/) {
  16     # HTTP or SSH
  17     # Above regex says "at least two chars before the :", to avoid
  18     # catching Win32 drives ("C:\").
  19     $defaultrepo_base = $defaultrepo;
  20     $defaultrepo_base =~ s#/[^/]+/?$##;
  21     $checked_out_tree = 0;
  22 }
  23 elsif ($defaultrepo =~ /^\/|\.\.\/|.:(\/|\\)/) {
  24     # Local filesystem, either absolute or relative path
  25     # (assumes a checked-out tree):
  26     $defaultrepo_base = $defaultrepo;
  27     $checked_out_tree = 1;
  28 }
  29 else {
  30     die "Couldn't work out defaultrepo";
  31 }
  32
  33 my $verbose = 2;
  34 my $get_mode;
  35
  36 # Flags specific to a particular command
  37 my $ignore_failure = 0;
  38 my $local_repo_unnecessary = 0;
  39
  40 # Always define the empty tag so that we fetch the /required/ packages
  41 my %tags;
  42 $tags{"-"} = 1;
  43
  44 sub message {
  45     if ($verbose >= 2) {
  46         print "@_\n";
  47     }
  48 }
  49
  50 sub warning {
  51     if ($verbose >= 1) {
  52         print "warning: @_\n";
  53     }
  54 }
  55
  56 sub scm {
  57     my $scm = shift;
  58
  59     message "== running $scm @_";
  60     system ($scm, @_) == 0
  61         or $ignore_failure
  62         or die "$scm failed: $?";
  63 }
  64
  65 sub repoexists {
  66     my ($scm, $localpath) = @_;
  67
  68     if ($scm eq "darcs") {
  69         -d "$localpath/_darcs";
  70     }
  71     else {
  72         -d "$localpath/.git";
  73     }
  74 }
  75
  76 sub scmall {
  77     my $command = shift;
  78
  79     my $localpath;
  80     my $tag;
  81     my $remotepath;
  82     my $scm;
  83     my $upstream;
  84
  85     my $path;
  86     my $wd_before = getcwd;
  87
  88     my @scm_args;
  89
  90     open IN, "< packages" or die "Can't open packages file";
  91     while (<IN>) {
  92         chomp;
  93         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+) +([^ ]+)$/) {
  94             $localpath = $1;
  95             $tag = defined($2) ? $2 : "";
  96             $remotepath = $3;
  97             $scm = $4;
  98             $upstream = $5;
  99
 100             # Check the SCM is OK as early as possible
 101             die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
 102
 103             # Work out the path for this package in the repo we pulled from
 104             if ($checked_out_tree) {
 105                 $path = "$defaultrepo_base/$localpath";
 106             }
 107             else {
 108                 $path = "$defaultrepo_base/$remotepath";
 109             }
 110
 111             # Work out the arguments we should give to the SCM
 112             if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 113                 @scm_args = (($scm eq "darcs" and "whatsnew")
 114                           or ($scm eq "git" and "status"));
 115
 116                 # Hack around 'darcs whatsnew' failing if there are no changes
 117                 $ignore_failure = 1;
 118             }
 119             elsif ($command =~ /^(?:pus|push)$/) {
 120                 @scm_args = "push";
 121             }
 122             elsif ($command =~ /^(?:pul|pull)$/) {
 123                 @scm_args = "pull";
 124                 # Q: should we append the -a argument for darcs repos?
 125             }
 126             elsif ($command =~ /^(?:g|ge|get)$/) {
 127                 # Skip any repositories we have not included the tag for
 128                 if (not defined($tags{$tag})) {
 129                     next;
 130                 }
 131
 132                 if (-d $localpath) {
 133                     warning("$localpath already present; omitting") if $localpath ne ".";
 134                     next;
 135                 }
 136
 137                 # The first time round the loop, default the get-mode
 138                 if (not defined($get_mode)) {
 139                     warning("adding --partial, to override use --complete");
 140                     $get_mode = "--partial";
 141                 }
 142
 143                 # The only command that doesn't need a repo
 144                 $local_repo_unnecessary = 1;
 145
 146                 if ($scm eq "darcs") {
 147                     # Note: we can only use the get-mode with darcs for now
 148                     @scm_args = ("get", $get_mode, $path, $localpath);
 149                 }
 150                 else {
 151                     @scm_args = ("clone", $path, $localpath);
 152                 }
 153             }
 154             elsif ($command =~ /^(?:s|se|sen|send)$/) {
 155                 @scm_args = (($scm eq "darcs" and "send")
 156                           or ($scm eq "git" and "send-email"));
 157             }
 158             else {
 159                 die "Unknown command: $command";
 160             }
 161
 162             # Actually execute the command
 163             chdir $wd_before or die "Could not change to $wd_before";
 164             if (repoexists ($scm, $localpath)) {
 165                 chdir $localpath or die "Could not change to $localpath";
 166                 scm ($scm, @scm_args, @_);
 167             }
 168             elsif ($local_repo_unnecessary) {
 169                 # Don't bother to change directory in this case
 170                 scm ($scm, @scm_args, @_);
 171             }
 172             elsif ($tag eq "") {
 173                 message "== Required repo $localpath is missing! Skipping";
 174             }
 175             else {
 176                 message "== $localpath repo not present; skipping";
 177             }
 178         }
 179         elsif (! /^(#.*)?$/) {
 180             die "Bad line: $_";
 181         }
 182     }
 183     close IN;
 184 }
 185
 186 sub main {
 187     if (! -d ".git" || ! -d "compiler") {
 188         die "error: sync-all must be run from the top level of the ghc tree."
 189     }
 190
 191     while ($#_ ne -1) {
 192         my $arg = shift;
 193         # We handle -q here as well as lower down as we need to skip over it
 194         # if it comes before the source-control command
 195         if ($arg eq "-q") {
 196             $verbose = 1;
 197         }
 198         elsif ($arg eq "-s") {
 199             $verbose = 0;
 200         }
 201         elsif ($arg eq "--ignore-failure") {
 202             $ignore_failure = 1;
 203         }
 204         elsif ($arg eq "--complete" || $arg eq "--partial") {
 205             $get_mode = $arg;
 206         }
 207         # --<tag> says we grab the libs tagged 'tag' with
 208         # 'get'. It has no effect on the other commands.
 209         elsif ($arg =~ m/^--/) {
 210             $arg =~ s/^--//;
 211             $tags{$arg} = 1;
 212         }
 213         else {
 214             unshift @_, $arg;
 215             if (grep /^-q$/, @_) {
 216                 $verbose = 1;
 217             }
 218             last;
 219         }
 220     }
 221
 222     if ($#_ eq -1) {
 223         # Get the built in help
 224         my $help = <<END;
 225 What do you want to do?
 226 Supported commands:
 227
 228  * whatsnew
 229  * push
 230  * pull
 231  * get, with options:
 232   * --<package-tag>
 233   * --complete
 234   * --partial
 235  * send
 236
 237 Available package-tags are:
 238 END
 239
 240         # Collect all the tags in the packages file
 241         my %available_tags;
 242         open IN, "< packages" or die "Can't open packages file";
 243         while (<IN>) {
 244             chomp;
 245             if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
 246                 if (defined($2)) {
 247                     $available_tags{$2} = 1;
 248                 }
 249             }
 250             elsif (! /^(#.*)?$/) {
 251                 die "Bad line: $_";
 252             }
 253         }
 254         close IN;
 255
 256         # Show those tags and the help text
 257         my @available_tags = keys %available_tags;
 258         print "$help@available_tags";
 259         exit 1;
 260     }
 261     else {
 262         # Give the command and rest of the arguments to the main loop
 263         scmall @_;
 264     }
 265 }
 266
 267 main(@ARGV);
 268