darcs-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my @top_dirs = ("nofib", "testsuite");
   6
   7 # Figure out where to get the other repositories from,
   8 # based on where this GHC repo came from.
   9 my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
  10 chomp $defaultrepo;
  11 my $defaultrepo_base;
  12 my $defaultrepo_lib;
  13
  14 if ($defaultrepo =~ /^...*:/) {
  15     # HTTP or SSH
  16     # Above regex says "at least two chars before the :", to avoid
  17     # catching Win32 drives ("C:\").
  18     $defaultrepo_base = $defaultrepo;
  19     $defaultrepo_base =~ s#/[^/]+/?$##;
  20     $defaultrepo_lib = "$defaultrepo_base/packages";
  21 }
  22 elsif ($defaultrepo =~ /^\//) {
  23     # Local filesystem, absolute path (assumes a checked-out tree):
  24     $defaultrepo_base = $defaultrepo;
  25     $defaultrepo_lib = "$defaultrepo/libraries";
  26 }
  27 elsif ($defaultrepo =~ /^..\//) {
  28     # Local filesystem, relative path (assumes a checked-out tree):
  29     $defaultrepo_base = $defaultrepo;
  30     $defaultrepo_lib = "$defaultrepo/libraries";
  31 }
  32 else {
  33     die "Couldn't work out defaultrepo";
  34 }
  35
  36 my $verbose = 2;
  37 my $ignore_failure = 0;
  38
  39 # --extra says we grab the extra libs with 'get'.  It has no effect on
  40 # the other commands.
  41 my $extra = 0;
  42 # --nofib/--testsuite tell get to also grab the respective repos.
  43 # They have no effect on the other commands.
  44 my $nofib = 0;
  45 my $testsuite = 0;
  46
  47 sub message {
  48     if ($verbose >= 2) {
  49         print "@_\n";
  50     }
  51 }
  52
  53 sub warning {
  54     if ($verbose >= 1) {
  55         print "warning: @_\n";
  56     }
  57 }
  58
  59 sub darcs {
  60     message "== running darcs @_";
  61     system ("darcs", @_) == 0
  62         or $ignore_failure
  63         or die "darcs failed: $?";
  64 }
  65
  66 sub darcsall {
  67     my @packages;
  68     darcs @_;
  69     for my $dir (@top_dirs) {
  70         if (-d $dir && -d "$dir/_darcs") {
  71             darcs (@_, "--repodir", $dir);
  72         }
  73         else {
  74             message "== $dir not present or not a repository; skipping";
  75         }
  76     }
  77     for my $path (<libraries/*/_darcs>) {
  78         chomp $path;
  79         if ($path =~ m#/(.*)/#) {
  80             my $pkg = $1;
  81             # bootstrapping.* are just copies of other repos; we don't
  82             # update them directly.
  83             if ($pkg !~ /bootstrapping/) {
  84                 darcs (@_, "--repodir", "libraries/$pkg");
  85             }
  86         }
  87         else {
  88             die "that pattern can't fail!";
  89         }
  90     }
  91     @packages = `cat libraries/boot-packages`;
  92     # @packages = `cat libraries/boot-packages libraries/extra-packages`;
  93     for my $pkg (@packages) {
  94         chomp $pkg;
  95         if (! -d "libraries/$pkg") {
  96             warning("$pkg doesn't exist, use 'darcs-all get' to get it");
  97         }
  98     }
  99 }
 100
 101 sub darcsgetpackage {
 102     my ($get_it, $r_flags, $repo_root, $package) = @_;
 103
 104     if ($get_it) {
 105         if (-d $package) {
 106             warning("$package already present; omitting");
 107         }
 108         else {
 109             darcs (@$r_flags, "$repo_root/$package");
 110         }
 111     }
 112 }
 113
 114 sub darcsget {
 115     my $r_flags;
 116     if (! grep /(?:--complete|--partial)/, @_) {
 117         warning("adding --partial, to override use --complete");
 118         $r_flags = [@_, "--partial"];
 119     }
 120     else {
 121         $r_flags = \@_;
 122     }
 123
 124     darcsgetpackage($nofib,     $r_flags, $defaultrepo_base, "nofib");
 125     darcsgetpackage($testsuite, $r_flags, $defaultrepo_base, "testsuite");
 126
 127     chdir "libraries";
 128
 129     my @packages;
 130     if ($extra) {
 131         @packages = `cat boot-packages extra-packages`;
 132     }
 133     else {
 134         @packages = `cat boot-packages`;
 135     }
 136
 137     for my $pkg (@packages) {
 138         chomp $pkg;
 139         darcsgetpackage(1, $r_flags, $defaultrepo_lib, $pkg);
 140     }
 141 }
 142
 143 sub main {
 144     if (! -d "_darcs" || ! -d "compiler") {
 145         die "error: darcs-all must be run from the top level of the ghc tree."
 146     }
 147
 148     while ($#_ ne -1) {
 149         my $arg = shift;
 150         # We handle -q here as well as lower down as we need to skip over it
 151         # if it comes before the darcs command
 152         if ($arg eq "-q") {
 153             $verbose = 1;
 154         }
 155         elsif ($arg eq "-s") {
 156             $verbose = 0;
 157         }
 158         elsif ($arg eq "--extra") {
 159             $extra = 1;
 160         }
 161         elsif ($arg eq "--nofib") {
 162             $nofib = 1;
 163         }
 164         elsif ($arg eq "--testsuite") {
 165             $testsuite = 1;
 166         }
 167         else {
 168             unshift @_, $arg;
 169             if (grep /^-q$/, @_) {
 170                 $verbose = 1;
 171             }
 172             last;
 173         }
 174     }
 175
 176     if ($#_ eq -1) {
 177         die "What do you want to do?";
 178     }
 179     my $command = $_[0];
 180     if ($command eq "get") {
 181         darcsget @_;
 182     }
 183     else {
 184         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 185             # Hack around whatsnew failing if there are no changes
 186             $ignore_failure = 1;
 187         }
 188         darcsall @_;
 189     }
 190 }
 191
 192 main(@ARGV);
 193