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 # 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     my $line;
 161
 162     my ($repo_base, $checked_out_tree) = getrepo();
 163
 164     open IN, "< packages" or die "Can't open packages file";
 165     @repos = <IN>;
 166     close IN;
 167
 168     $line = 0;
 169     foreach (@repos) {
 170         chomp;
 171         $line++;
 172         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
 173             $localpath = $1;
 174             $tag = $2;
 175             $remotepath = $3;
 176
 177             if ($checked_out_tree) {
 178                 $path = "$repo_base/$localpath";
 179             }
 180             else {
 181                 $path = "$repo_base/$remotepath";
 182             }
 183
 184             if (-d "$localpath/_darcs") {
 185                 if ($want_remote_repo) {
 186                     if ($command =~ /^opt/) {
 187                         # Allows ./darcs-all optimize --relink
 188                         darcs (@_, "--repodir", $localpath, "--sibling=$path");
 189                     } else {
 190                         darcs (@_, "--repodir", $localpath, $path);
 191                     }
 192                 } else {
 193                     darcs (@_, "--repodir", $localpath);
 194                 }
 195             }
 196             elsif ($tag eq "-") {
 197                 message "== Required repo $localpath is missing! Skipping";
 198             }
 199             else {
 200                 message "== $localpath repo not present; skipping";
 201             }
 202         }
 203         elsif (! /^(#.*)?$/) {
 204             die "Bad content on line $line of packages file: $_";
 205         }
 206     }
 207 }
 208
 209 sub darcsget {
 210     my $r_flags;
 211     my $localpath;
 212     my $remotepath;
 213     my $path;
 214     my $tag;
 215     my @repos;
 216     my $line;
 217
 218     my ($repo_base, $checked_out_tree) = getrepo();
 219
 220     if (! grep /(?:--complete|--partial|--lazy)/, @_) {
 221         warning("adding --partial, to override use --complete");
 222         $r_flags = [@_, "--partial"];
 223     }
 224     else {
 225         $r_flags = \@_;
 226     }
 227
 228     open IN, "< packages" or die "Can't open packages file";
 229     @repos = <IN>;
 230     close IN;
 231
 232     $line = 0;
 233     foreach (@repos) {
 234         chomp;
 235         $line++;
 236         if (/^([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
 237             $localpath = $1;
 238             $tag = $2;
 239             $remotepath = $3;
 240
 241             if ($checked_out_tree) {
 242                 $path = "$repo_base/$localpath";
 243             }
 244             else {
 245                 $path = "$repo_base/$remotepath";
 246             }
 247
 248             if (($tag eq "-") || defined($tags{$tag})) {
 249                 if (-d $localpath) {
 250                     warning("$localpath already present; omitting");
 251                 }
 252                 else {
 253                     darcs (@$r_flags, $path, $localpath);
 254                 }
 255             }
 256         }
 257         elsif (! /^(#.*)?$/) {
 258             die "Bad content on line $line of packages file: $_";
 259         }
 260     }
 261 }
 262
 263 sub main {
 264     if (! -d "compiler") {
 265         die "error: darcs-all must be run from the top level of the ghc tree."
 266     }
 267
 268     while ($#_ ne -1) {
 269         my $arg = shift;
 270         # We handle -q here as well as lower down as we need to skip over it
 271         # if it comes before the darcs command
 272         if ($arg eq "-q") {
 273             $verbose = 1;
 274         }
 275         elsif ($arg eq "-s") {
 276             $verbose = 0;
 277         }
 278         elsif ($arg eq "-r") {
 279             $defaultrepo = shift;
 280         }
 281         elsif ($arg eq "-i") {
 282             $ignore_failure = 1;
 283         }
 284         # --nofib tells get to also grab the nofib repo.
 285         # It has no effect on the other commands.
 286         elsif ($arg eq "--nofib") {
 287             $tags{"nofib"} = 1;
 288         }
 289         # --testsuite tells get to also grab the testsuite repo.
 290         # It has no effect on the other commands.
 291         elsif ($arg eq "--testsuite") {
 292             $tags{"testsuite"} = 1;
 293         }
 294         # --extralibs tells get to also grab the extra repos.
 295         # It has no effect on the other commands.
 296         elsif ($arg eq "--extra") {
 297             $tags{"extra"} = 1;
 298         }
 299         elsif ($arg eq "--checked-out") {
 300             $checked_out_flag = 1;
 301         }
 302         else {
 303             unshift @_, $arg;
 304             if (grep /^-q$/, @_) {
 305                 $verbose = 1;
 306             }
 307             last;
 308         }
 309     }
 310
 311     if ($#_ eq -1) {
 312         die "What do you want to do?";
 313     }
 314     my $command = $_[0];
 315     if ($command eq "get") {
 316         darcsget @_;
 317     }
 318     else {
 319         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 320             # Hack around whatsnew failing if there are no changes
 321             $ignore_failure = 1;
 322         }
 323         if ($command =~ /^(pul|pus|sen|put|opt)/) {
 324             $want_remote_repo = 1;
 325         }
 326         darcsall @_;
 327     }
 328 }
 329
 330 END {
 331     my $ec = $?;
 332
 333     message "== Checking for old bytestring repo";
 334     if (-d "libraries/bytestring/_darcs") {
 335         if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
 336             print <<EOF;
 337 ============================
 338 ATTENTION!
 339
 340 You have an old bytestring repository in your GHC tree!
 341
 342 Please remove it (e.g. "rm -r libraries/bytestring"), and the new
 343 version of bytestring will be used from a tarball instead.
 344 ============================
 345 EOF
 346         }
 347     }
 348
 349     message "== Checking for bytestring tarball";
 350     if (-d "libraries/bytestring" && not -d "libraries/bytestring/_darcs") {
 351         print <<EOF;
 352 ============================
 353 ATTENTION!
 354
 355 You have an old bytestring in your GHC tree!
 356
 357 Please remove it (e.g. "rm -r libraries/bytestring"), and then run
 358 "./darcs-all get" to get the darcs repository.
 359 ============================
 360 EOF
 361     }
 362
 363     message "== Checking for unpulled tarball patches";
 364     if ((system "darcs annotate --match 'hash 20090930200358-3fd76-cab3bf4a0a9e3902eb6dd41f71712ad3a6a9bcd1' > /dev/null 2> /dev/null") == 0) {
 365         print <<EOF;
 366 ============================
 367 ATTENTION!
 368
 369 You have the unpulled tarball patches in your GHC tree!
 370
 371 Please remove them:
 372     darcs unpull -p "Use mingw tarballs to get mingw on Windows"
 373 and say yes to each patch.
 374 ============================
 375 EOF
 376     }
 377
 378     $? = $ec;
 379 }
 380
 381 main(@ARGV);
 382