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