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