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