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
 129     my ($repo_base, $checked_out_tree) = getrepo();
 130
 131     open IN, "< packages" or die "Can't open packages file";
 132     @repos = <IN>;
 133     close IN;
 134
 135     foreach (@repos) {
 136         chomp;
 137         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
 138             $localpath = $1;
 139             $tag = defined($2) ? $2 : "";
 140             $remotepath = $3;
 141
 142             if ($checked_out_tree) {
 143                 $path = "$repo_base/$localpath";
 144             }
 145             else {
 146                 $path = "$repo_base/$remotepath";
 147             }
 148
 149             if (-d "$localpath/_darcs") {
 150                 if ($want_remote_repo) {
 151                     darcs (@_, "--repodir", $localpath, $path);
 152                 } else {
 153                     darcs (@_, "--repodir", $localpath);
 154                 }
 155             }
 156             elsif ($tag eq "") {
 157                 message "== Required repo $localpath is missing! Skipping";
 158             }
 159             else {
 160                 message "== $localpath repo not present; skipping";
 161             }
 162         }
 163         elsif (! /^(#.*)?$/) {
 164             die "Bad line: $_";
 165         }
 166     }
 167 }
 168
 169 sub darcsget {
 170     my $r_flags;
 171     my $localpath;
 172     my $remotepath;
 173     my $path;
 174     my $tag;
 175     my @repos;
 176
 177     my ($repo_base, $checked_out_tree) = getrepo();
 178
 179     if (! grep /(?:--complete|--partial)/, @_) {
 180         warning("adding --partial, to override use --complete");
 181         $r_flags = [@_, "--partial"];
 182     }
 183     else {
 184         $r_flags = \@_;
 185     }
 186
 187     open IN, "< packages" or die "Can't open packages file";
 188     @repos = <IN>;
 189     close IN;
 190
 191     foreach (@repos) {
 192         chomp;
 193         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
 194             $localpath = $1;
 195             $tag = defined($2) ? $2 : "";
 196             $remotepath = $3;
 197
 198             if ($checked_out_tree) {
 199                 $path = "$repo_base/$localpath";
 200             }
 201             else {
 202                 $path = "$repo_base/$remotepath";
 203             }
 204
 205             if (($tag eq "") || defined($tags{$tag})) {
 206                 if (-d $localpath) {
 207                     warning("$localpath already present; omitting");
 208                 }
 209                 else {
 210                     darcs (@$r_flags, $path, $localpath);
 211                 }
 212             }
 213         }
 214         elsif (! /^(#.*)?$/) {
 215             die "Bad line: $_";
 216         }
 217     }
 218 }
 219
 220 sub main {
 221     if (! -d "compiler") {
 222         die "error: darcs-all must be run from the top level of the ghc tree."
 223     }
 224
 225     while ($#_ ne -1) {
 226         my $arg = shift;
 227         # We handle -q here as well as lower down as we need to skip over it
 228         # if it comes before the darcs command
 229         if ($arg eq "-q") {
 230             $verbose = 1;
 231         }
 232         elsif ($arg eq "-s") {
 233             $verbose = 0;
 234         }
 235         elsif ($arg eq "-r") {
 236             $defaultrepo = shift;
 237         }
 238         elsif ($arg eq "-i") {
 239             $ignore_failure = 1;
 240         }
 241         # --nofib tells get to also grab the nofib repo.
 242         # It has no effect on the other commands.
 243         elsif ($arg eq "--nofib") {
 244             $tags{"nofib"} = 1;
 245         }
 246         # --testsuite tells get to also grab the testsuite repo.
 247         # It has no effect on the other commands.
 248         elsif ($arg eq "--testsuite") {
 249             $tags{"testsuite"} = 1;
 250         }
 251         elsif ($arg eq "--checked-out") {
 252             $checked_out_flag = 1;
 253         }
 254         else {
 255             unshift @_, $arg;
 256             if (grep /^-q$/, @_) {
 257                 $verbose = 1;
 258             }
 259             last;
 260         }
 261     }
 262
 263     if ($#_ eq -1) {
 264         die "What do you want to do?";
 265     }
 266     my $command = $_[0];
 267     if ($command eq "get") {
 268         darcsget @_;
 269     }
 270     else {
 271         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 272             # Hack around whatsnew failing if there are no changes
 273             $ignore_failure = 1;
 274         }
 275         if ($command =~ /^(pul|pus|sen|put)/) {
 276             $want_remote_repo = 1;
 277         }
 278         darcsall @_;
 279     }
 280 }
 281
 282 END {
 283     message "== Checking for old bytestring repo";
 284     if (-d "libraries/bytestring/_darcs") {
 285         if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
 286             print <<EOF;
 287 ============================
 288 ATTENTION!
 289
 290 You have an old bytestring repository in your GHC tree!
 291
 292 Please remove it (e.g. "rm -r libraries/bytestring"), and the new
 293 version of bytestring will be used from a tarball instead.
 294 ============================
 295 EOF
 296         }
 297     }
 298
 299     message "== Checking for unpulled tarball patches";
 300     if ((system "darcs annotate --match 'hash 20090930200358-3fd76-cab3bf4a0a9e3902eb6dd41f71712ad3a6a9bcd1' > /dev/null 2> /dev/null") == 0) {
 301         print <<EOF;
 302 ============================
 303 ATTENTION!
 304
 305 You have the unpulled tarball patches in your GHC tree!
 306
 307 Please remove them:
 308     darcs unpull -p "Use mingw tarballs to get mingw on Windows"
 309 and say yes to each patch.
 310 ============================
 311 EOF
 312     }
 313 }
 314
 315 main(@ARGV);
 316