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