darcs-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 # Usage:
   6 #
   7 # ./darcs-all [-q] [-s] [-i] [-r repo]
   8 #             [--nofib] [--testsuite] [--checked-out] cmd [darcs flags]
   9 #
  10 # Applies the darcs command "cmd" to each repository in the tree.
  11 #
  12 # e.g.
  13 #      ./darcs-all -r http://darcs.haskell.org/ghc get
  14 #          To get any repos which do not exist in the local tree
  15 #
  16 #      ./darcs-all -r ~/ghc-validate push
  17 #          To push all your repos to the ~/ghc-validate tree
  18 #
  19 #      ./darcs-all pull -a
  20 #          To pull everything from the default repos
  21 #
  22 #      ./darc-all push --dry-run
  23 #          To see what local patches you have relative to the main repos
  24 #
  25 # -------------- Flags -------------------
  26 #   -q says to be quite, and -s to be silent.
  27 #
  28 #   -i says to ignore darcs errors and move on to the next repository
  29 #
  30 #   -r repo says to use repo as the location of package repositories
  31 #
  32 #   --checked-out says that the remote repo is in checked-out layout, as
  33 #   opposed to the layout used for the main repo.  By default a repo on
  34 #   the local filesystem is assumed to be checked-out, and repos accessed
  35 #   via HTTP or SSH are assumed to be in the main repo layout; use
  36 #   --checked-out to override the latter.
  37 #
  38 #   --nofib, --testsuite also get the nofib and testsuite repos respectively
  39 #
  40 #   The darcs get flag you are most likely to want is --complete. By
  41 #   default we pass darcs the --partial flag.
  42 #
  43 # ------------ Which repos to use -------------
  44 # darcs-all uses the following algorithm to decide which remote repos to use
  45 #
  46 #  It always computes the remote repos from a single base, $repo_base
  47 #  How is $repo_base set?
  48 #    If you say "-r repo", then that's $repo_base
  49 #    othewise $repo_base is set thus:
  50 #       look in _darcs/prefs/defaultrepo,
  51 #       and remove the trailing 'ghc'
  52 #
  53 #  Then darcs-all iterates over the package found in the file
  54 #  ./packages, which has entries like:
  55 #         libraries/array  packages/array  darcs
  56 #    or, in general
  57 #         <local-path>  <remote-path> <vcs>
  58 #
  59 #    If $repo_base looks like a local filesystem path, or if you give
  60 #    the --checked-out flag, darcs-all works on repos of form
  61 #          $repo_base/<local-path>
  62 #    otherwise darcs-all works on repos of form
  63 #          $repo_base/<remote-path>
  64 #    This logic lets you say
  65 #      both    darcs-all -r http://darcs.haskell.org/ghc-6.12 pull
  66 #      and     darcs-all -r ../HEAD pull
  67 #    The latter is called a "checked-out tree".
  68
  69 # NB: darcs-all *ignores* the defaultrepo of all repos other than the
  70 # root one.  So the remote repos must be laid out in one of the two
  71 # formats given by <local-path> and <remote-path> in the file 'packages'.
  72
  73
  74 $| = 1; # autoflush stdout after each print, to avoid output after die
  75
  76 my $defaultrepo;
  77
  78 my $verbose = 2;
  79 my $ignore_failure = 0;
  80 my $want_remote_repo = 0;
  81 my $checked_out_flag = 0;
  82
  83 my %tags;
  84
  85 my @packages;
  86
  87 # Figure out where to get the other repositories from.
  88 sub getrepo {
  89     my $basedir = ".";
  90     my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
  91     chomp $repo;
  92
  93     my $repo_base;
  94     my $checked_out_tree;
  95
  96     if ($repo =~ /^...*:/) {
  97         # HTTP or SSH
  98         # Above regex says "at least two chars before the :", to avoid
  99         # catching Win32 drives ("C:\").
 100         $repo_base = $repo;
 101
 102         # --checked-out is needed if you want to use a checked-out repo
 103         # over SSH or HTTP
 104         if ($checked_out_flag) {
 105             $checked_out_tree = 1;
 106         } else {
 107             $checked_out_tree = 0;
 108         }
 109
 110         # Don't drop the last part of the path if specified with -r, as
 111         # it expects repos of the form:
 112         #
 113         #   http://darcs.haskell.org
 114         #
 115         # rather than
 116         #
 117         #   http://darcs.haskell.org/ghc
 118         #
 119         if (!$defaultrepo) {
 120             $repo_base =~ s#/[^/]+/?$##;
 121         }
 122     }
 123     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
 124         # Local filesystem, either absolute or relative path
 125         # (assumes a checked-out tree):
 126         $repo_base = $repo;
 127         $checked_out_tree = 1;
 128     }
 129     else {
 130         die "Couldn't work out repo";
 131     }
 132
 133     return $repo_base, $checked_out_tree;
 134 }
 135
 136 sub message {
 137     if ($verbose >= 2) {
 138         print "@_\n";
 139     }
 140 }
 141
 142 sub warning {
 143     if ($verbose >= 1) {
 144         print "warning: @_\n";
 145     }
 146 }
 147
 148 sub darcs {
 149     message "== running darcs @_";
 150     system ("darcs", @_) == 0
 151        or $ignore_failure
 152        or die "darcs failed: $?";
 153 }
 154
 155 sub parsePackages {
 156     my @repos;
 157     my $lineNum;
 158
 159     my ($repo_base, $checked_out_tree) = getrepo();
 160
 161     open IN, "< packages" or die "Can't open packages file";
 162     @repos = <IN>;
 163     close IN;
 164
 165     @packages = ();
 166     $lineNum = 0;
 167     foreach (@repos) {
 168         chomp;
 169         $lineNum++;
 170         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
 171             my %line;
 172             $line{"localpath"}  = $1;
 173             $line{"tag"}        = $2;
 174             $line{"remotepath"} = $3;
 175             $line{"vcs"}        = $4;
 176             $line{"upstream"}   = $5;
 177             push @packages, \%line;
 178         }
 179         elsif (! /^(#.*)?$/) {
 180             die "Bad content on line $lineNum of packages file: $_";
 181         }
 182     }
 183 }
 184
 185 sub darcsall {
 186     my $localpath;
 187     my $remotepath;
 188     my $path;
 189     my $tag;
 190     my @repos;
 191     my $command = $_[0];
 192     my $line;
 193
 194     my ($repo_base, $checked_out_tree) = getrepo();
 195
 196     for $line (@packages) {
 197         $localpath  = $$line{"localpath"};
 198         $tag        = $$line{"tag"};
 199         $remotepath = $$line{"remotepath"};
 200
 201         if ($checked_out_tree) {
 202             $path = "$repo_base/$localpath";
 203         }
 204         else {
 205             $path = "$repo_base/$remotepath";
 206         }
 207
 208         if (-d "$localpath/_darcs") {
 209             if ($want_remote_repo) {
 210                 if ($command =~ /^opt/) {
 211                     # Allows ./darcs-all optimize --relink
 212                     darcs (@_, "--repodir", $localpath, "--sibling=$path");
 213                 } else {
 214                     darcs (@_, "--repodir", $localpath, $path);
 215                 }
 216             } else {
 217                 darcs (@_, "--repodir", $localpath);
 218             }
 219         }
 220         elsif ($tag eq "-") {
 221             message "== Required repo $localpath is missing! Skipping";
 222         }
 223         else {
 224             message "== $localpath repo not present; skipping";
 225         }
 226     }
 227 }
 228
 229 sub darcsget {
 230     my $r_flags;
 231     my $localpath;
 232     my $remotepath;
 233     my $path;
 234     my $tag;
 235     my @repos;
 236     my $line;
 237
 238     my ($repo_base, $checked_out_tree) = getrepo();
 239
 240     if (! grep /(?:--complete|--partial|--lazy)/, @_) {
 241         warning("adding --partial, to override use --complete");
 242         $r_flags = [@_, "--partial"];
 243     }
 244     else {
 245         $r_flags = \@_;
 246     }
 247
 248     for $line (@packages) {
 249         $localpath  = $$line{"localpath"};
 250         $tag        = $$line{"tag"};
 251         $remotepath = $$line{"remotepath"};
 252
 253         if ($checked_out_tree) {
 254             $path = "$repo_base/$localpath";
 255         }
 256         else {
 257             $path = "$repo_base/$remotepath";
 258         }
 259
 260         if ($tags{$tag} eq 1) {
 261             if (-d $localpath) {
 262                 warning("$localpath already present; omitting");
 263             }
 264             else {
 265                 darcs (@$r_flags, $path, $localpath);
 266             }
 267         }
 268     }
 269 }
 270
 271 sub darcsupstreampull {
 272     my $localpath;
 273     my $upstream;
 274     my $line;
 275
 276     for $line (@packages) {
 277         $localpath  = $$line{"localpath"};
 278         $upstream   = $$line{"upstream"};
 279
 280         if ($upstream ne "-") {
 281             if (-d $localpath) {
 282                 darcs ("pull", @_, "--repodir", $localpath, $upstream);
 283             }
 284         }
 285     }
 286 }
 287
 288 sub main {
 289     if (! -d "compiler") {
 290         die "error: darcs-all must be run from the top level of the ghc tree."
 291     }
 292
 293     $tags{"-"} = 1;
 294     $tags{"dph"} = 1;
 295     $tags{"nofib"} = 0;
 296     $tags{"testsuite"} = 0;
 297     $tags{"extra"} = 0;
 298
 299     while ($#_ ne -1) {
 300         my $arg = shift;
 301         # We handle -q here as well as lower down as we need to skip over it
 302         # if it comes before the darcs command
 303         if ($arg eq "-q") {
 304             $verbose = 1;
 305         }
 306         elsif ($arg eq "-s") {
 307             $verbose = 0;
 308         }
 309         elsif ($arg eq "-r") {
 310             $defaultrepo = shift;
 311         }
 312         elsif ($arg eq "-i") {
 313             $ignore_failure = 1;
 314         }
 315         # --nofib tells get to also grab the nofib repo.
 316         # It has no effect on the other commands.
 317         elsif ($arg eq "--nofib") {
 318             $tags{"nofib"} = 1;
 319         }
 320         elsif ($arg eq "--no-nofib") {
 321             $tags{"nofib"} = 0;
 322         }
 323         # --testsuite tells get to also grab the testsuite repo.
 324         # It has no effect on the other commands.
 325         elsif ($arg eq "--testsuite") {
 326             $tags{"testsuite"} = 1;
 327         }
 328         elsif ($arg eq "--no-testsuite") {
 329             $tags{"testsuite"} = 0;
 330         }
 331         # --dph tells get to also grab the dph repo.
 332         # It has no effect on the other commands.
 333         elsif ($arg eq "--dph") {
 334             $tags{"dph"} = 1;
 335         }
 336         elsif ($arg eq "--no-dph") {
 337             $tags{"dph"} = 0;
 338         }
 339         # --extralibs tells get to also grab the extra repos.
 340         # It has no effect on the other commands.
 341         elsif ($arg eq "--extra") {
 342             $tags{"extra"} = 1;
 343         }
 344         elsif ($arg eq "--no-extra") {
 345             $tags{"extra"} = 0;
 346         }
 347         # Use --checked-out if the remote repos are a checked-out tree,
 348         # rather than the master trees.
 349         elsif ($arg eq "--checked-out") {
 350             $checked_out_flag = 1;
 351         }
 352         else {
 353             unshift @_, $arg;
 354             if (grep /^-q$/, @_) {
 355                 $verbose = 1;
 356             }
 357             last;
 358         }
 359     }
 360
 361     if ($#_ eq -1) {
 362         die "What do you want to do?";
 363     }
 364     my $command = $_[0];
 365     parsePackages;
 366     if ($command eq "get") {
 367         darcsget @_;
 368     }
 369     elsif ($command eq "upstreampull") {
 370         shift;
 371         darcsupstreampull @_;
 372     }
 373     else {
 374         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 375             # Hack around whatsnew failing if there are no changes
 376             $ignore_failure = 1;
 377         }
 378         if ($command =~ /^(pul|pus|sen|put|opt)/) {
 379             $want_remote_repo = 1;
 380         }
 381         darcsall @_;
 382     }
 383 }
 384
 385 END {
 386     my $ec = $?;
 387
 388     message "== Checking for old bytestring repo";
 389     if (-d "libraries/bytestring/_darcs") {
 390         if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
 391             print <<EOF;
 392 ============================
 393 ATTENTION!
 394
 395 You have an old bytestring repository in your GHC tree!
 396
 397 Please remove it (e.g. "rm -r libraries/bytestring"), and the new
 398 version of bytestring will be used from a tarball instead.
 399 ============================
 400 EOF
 401         }
 402     }
 403
 404     message "== Checking for bytestring tarball";
 405     if (-d "libraries/bytestring" && not -d "libraries/bytestring/_darcs") {
 406         print <<EOF;
 407 ============================
 408 ATTENTION!
 409
 410 You have an old bytestring in your GHC tree!
 411
 412 Please remove it (e.g. "rm -r libraries/bytestring"), and then run
 413 "./darcs-all get" to get the darcs repository.
 414 ============================
 415 EOF
 416     }
 417
 418     message "== Checking for unpulled tarball patches";
 419     if ((system "darcs annotate --match 'hash 20090930200358-3fd76-cab3bf4a0a9e3902eb6dd41f71712ad3a6a9bcd1' > /dev/null 2> /dev/null") == 0) {
 420         print <<EOF;
 421 ============================
 422 ATTENTION!
 423
 424 You have the unpulled tarball patches in your GHC tree!
 425
 426 Please remove them:
 427     darcs unpull -p "Use mingw tarballs to get mingw on Windows"
 428 and say yes to each patch.
 429 ============================
 430 EOF
 431     }
 432
 433     $? = $ec;
 434 }
 435
 436 main(@ARGV);
 437