sync-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Cwd;
   5
   6 my $defaultrepo;
   7 my @packages;
   8 my $verbose = 2;
   9 my $ignore_failure = 0;
  10 my $want_remote_repo = 0;
  11 my $checked_out_flag = 0;
  12 my $get_mode;
  13
  14 # Flags specific to a particular command
  15 my $local_repo_unnecessary = 0;
  16
  17 my %tags;
  18
  19 # Figure out where to get the other repositories from.
  20 sub getrepo {
  21     my $basedir = ".";
  22     my $repo;
  23
  24     if (defined($defaultrepo)) {
  25         $repo = $defaultrepo;
  26         chomp $repo;
  27     } else {
  28         # Figure out where to get the other repositories from,
  29         # based on where this GHC repo came from.
  30         my $branch = `git branch | grep "\* " | sed "s/^\* //"`; chomp $branch;
  31         my $remote = `git config branch.$branch.remote`;         chomp $remote;
  32         $repo = `git config remote.$remote.url`;       chomp $repo;
  33     }
  34
  35     my $repo_base;
  36     my $checked_out_tree;
  37
  38     if ($repo =~ /^...*:/) {
  39         # HTTP or SSH
  40         # Above regex says "at least two chars before the :", to avoid
  41         # catching Win32 drives ("C:\").
  42         $repo_base = $repo;
  43
  44         # --checked-out is needed if you want to use a checked-out repo
  45         # over SSH or HTTP
  46         if ($checked_out_flag) {
  47             $checked_out_tree = 1;
  48         } else {
  49             $checked_out_tree = 0;
  50         }
  51
  52         # Don't drop the last part of the path if specified with -r, as
  53         # it expects repos of the form:
  54         #
  55         #   http://darcs.haskell.org
  56         #
  57         # rather than
  58         #
  59         #   http://darcs.haskell.org/ghc
  60         #
  61         if (!$defaultrepo) {
  62             $repo_base =~ s#/[^/]+/?$##;
  63         }
  64     }
  65     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
  66         # Local filesystem, either absolute or relative path
  67         # (assumes a checked-out tree):
  68         $repo_base = $repo;
  69         $checked_out_tree = 1;
  70     }
  71     else {
  72         die "Couldn't work out repo";
  73     }
  74
  75     return $repo_base, $checked_out_tree;
  76 }
  77
  78 sub parsePackages {
  79     my @repos;
  80     my $lineNum;
  81
  82     open IN, "< packages" or die "Can't open packages file";
  83     @repos = <IN>;
  84     close IN;
  85
  86     @packages = ();
  87     $lineNum = 0;
  88     foreach (@repos) {
  89         chomp;
  90         $lineNum++;
  91         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
  92             my %line;
  93             $line{"localpath"}  = $1;
  94             $line{"tag"}        = $2;
  95             $line{"remotepath"} = $3;
  96             $line{"vcs"}        = $4;
  97             $line{"upstream"}   = $5;
  98             push @packages, \%line;
  99         }
 100         elsif (! /^(#.*)?$/) {
 101             die "Bad content on line $lineNum of packages file: $_";
 102         }
 103     }
 104 }
 105
 106 sub message {
 107     if ($verbose >= 2) {
 108         print "@_\n";
 109     }
 110 }
 111
 112 sub warning {
 113     if ($verbose >= 1) {
 114         print "warning: @_\n";
 115     }
 116 }
 117
 118 sub scm {
 119     my $dir = shift;
 120     my $scm = shift;
 121     my $pwd;
 122
 123     if ($dir eq '.') {
 124         message "== running $scm @_";
 125     } else {
 126         message "== $dir: running $scm @_";
 127         $pwd = getcwd();
 128         chdir($dir);
 129     }
 130
 131     system ($scm, @_) == 0
 132         or $ignore_failure
 133         or die "$scm failed: $?";
 134
 135     if ($dir ne '.') {
 136         chdir($pwd);
 137     }
 138 }
 139
 140 sub repoexists {
 141     my ($scm, $localpath) = @_;
 142
 143     if ($scm eq "darcs") {
 144         -d "$localpath/_darcs";
 145     }
 146     else {
 147         -d "$localpath/.git";
 148     }
 149 }
 150
 151 sub scmall {
 152     my $command = shift;
 153
 154     my $localpath;
 155     my $tag;
 156     my $remotepath;
 157     my $scm;
 158     my $upstream;
 159     my $line;
 160
 161     my $path;
 162     my $wd_before = getcwd;
 163
 164     my @scm_args;
 165
 166     my $pwd;
 167
 168     my ($repo_base, $checked_out_tree) = getrepo();
 169
 170     parsePackages;
 171
 172     for $line (@packages) {
 173
 174             $localpath  = $$line{"localpath"};
 175             $tag        = $$line{"tag"};
 176             $remotepath = $$line{"remotepath"};
 177             $scm        = $$line{"vcs"};
 178             $upstream   = $$line{"upstream"};
 179
 180             # Check the SCM is OK as early as possible
 181             die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
 182
 183             # Work out the path for this package in the repo we pulled from
 184             if ($checked_out_tree) {
 185                 $path = "$repo_base/$localpath";
 186             }
 187             else {
 188                 $path = "$repo_base/$remotepath";
 189             }
 190
 191             # Work out the arguments we should give to the SCM
 192             if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 193                 @scm_args = (($scm eq "darcs" and "whatsnew")
 194                           or ($scm eq "git" and "status"));
 195
 196                 # Hack around 'darcs whatsnew' failing if there are no changes
 197                 $ignore_failure = 1;
 198             }
 199             elsif ($command =~ /^(?:pus|push)$/) {
 200                 @scm_args = "push";
 201                 $want_remote_repo = 1;
 202             }
 203             elsif ($command =~ /^(?:pul|pull)$/) {
 204                 @scm_args = "pull";
 205                 $want_remote_repo = 1;
 206                 # Q: should we append the -a argument for darcs repos?
 207             }
 208             elsif ($command =~ /^(?:g|ge|get)$/) {
 209                 # Skip any repositories we have not included the tag for
 210                 if (not defined($tags{$tag})) {
 211                     next;
 212                 }
 213
 214                 if (-d $localpath) {
 215                     warning("$localpath already present; omitting") if $localpath ne ".";
 216                     next;
 217                 }
 218
 219                 # The first time round the loop, default the get-mode
 220                 if (not defined($get_mode)) {
 221                     warning("adding --partial, to override use --complete");
 222                     $get_mode = "--partial";
 223                 }
 224
 225                 # The only command that doesn't need a repo
 226                 $local_repo_unnecessary = 1;
 227
 228                 if ($scm eq "darcs") {
 229                     # Note: we can only use the get-mode with darcs for now
 230                     @scm_args = ("get", $get_mode, $path, $localpath);
 231                 }
 232                 else {
 233                     @scm_args = ("clone", $path, $localpath);
 234                 }
 235             }
 236             elsif ($command =~ /^(?:s|se|sen|send)$/) {
 237                 @scm_args = (($scm eq "darcs" and "send")
 238                           or ($scm eq "git" and "send-email"));
 239                 $want_remote_repo = 1;
 240             }
 241             else {
 242                 die "Unknown command: $command";
 243             }
 244
 245             # Actually execute the command
 246             if (repoexists ($scm, $localpath)) {
 247                 if ($want_remote_repo) {
 248                     if ($scm eq "darcs") {
 249                         scm (".", $scm, @scm_args, @_, "--repodir=$localpath", $path);
 250                     } else {
 251                         # git pull doesn't like to be used with --work-dir
 252                         # I couldn't find an alternative to chdir() here
 253                         scm ($localpath, $scm, @scm_args, @_, $path, "master");
 254                     }
 255                 } else {
 256                     # git status *must* be used with --work-dir, if we don't chdir() to the dir
 257                     scm ($localpath, $scm, @scm_args, @_);
 258                 }
 259             }
 260             elsif ($local_repo_unnecessary) {
 261                 # Don't bother to change directory in this case
 262                 scm (".", $scm, @scm_args, @_);
 263             }
 264             elsif ($tag eq "") {
 265                 message "== Required repo $localpath is missing! Skipping";
 266             }
 267             else {
 268                 message "== $localpath repo not present; skipping";
 269             }
 270     }
 271 }
 272
 273 sub main {
 274     if (! -d ".git" || ! -d "compiler") {
 275         die "error: sync-all must be run from the top level of the ghc tree."
 276     }
 277
 278     $tags{"-"} = 1;
 279     $tags{"dph"} = 1;
 280
 281     while ($#_ ne -1) {
 282         my $arg = shift;
 283         # We handle -q here as well as lower down as we need to skip over it
 284         # if it comes before the source-control command
 285         if ($arg eq "-q") {
 286             $verbose = 1;
 287         }
 288         elsif ($arg eq "-s") {
 289             $verbose = 0;
 290         }
 291         elsif ($arg eq "-r") {
 292             $defaultrepo = shift;
 293         }
 294         elsif ($arg eq "--ignore-failure") {
 295             $ignore_failure = 1;
 296         }
 297         elsif ($arg eq "--complete" || $arg eq "--partial") {
 298             $get_mode = $arg;
 299         }
 300         # Use --checked-out if the remote repos are a checked-out tree,
 301         # rather than the master trees.
 302         elsif ($arg eq "--checked-out") {
 303             $checked_out_flag = 1;
 304         }
 305         # --<tag> says we grab the libs tagged 'tag' with
 306         # 'get'. It has no effect on the other commands.
 307         elsif ($arg =~ m/^--/) {
 308             $arg =~ s/^--//;
 309             $tags{$arg} = 1;
 310         }
 311         else {
 312             unshift @_, $arg;
 313             if (grep /^-q$/, @_) {
 314                 $verbose = 1;
 315             }
 316             last;
 317         }
 318     }
 319
 320     if ($#_ eq -1) {
 321         # Get the built in help
 322         my $help = <<END;
 323 What do you want to do?
 324 Supported commands:
 325
 326  * whatsnew
 327  * push
 328  * pull
 329  * get, with options:
 330   * --<package-tag>
 331   * --complete
 332   * --partial
 333  * send
 334
 335 Available package-tags are:
 336 END
 337
 338         # Collect all the tags in the packages file
 339         my %available_tags;
 340         open IN, "< packages" or die "Can't open packages file";
 341         while (<IN>) {
 342             chomp;
 343             if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
 344                 if (defined($2) && $2 ne "-") {
 345                     $available_tags{$2} = 1;
 346                 }
 347             }
 348             elsif (! /^(#.*)?$/) {
 349                 die "Bad line: $_";
 350             }
 351         }
 352         close IN;
 353
 354         # Show those tags and the help text
 355         my @available_tags = keys %available_tags;
 356         print "$help@available_tags\n";
 357         exit 1;
 358     }
 359     else {
 360         # Give the command and rest of the arguments to the main loop
 361         scmall @_;
 362     }
 363 }
 364
 365 main(@ARGV);
 366