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     darcs @_;
  66     for my $dir (@top_dirs) {
  67         if (-d $dir && -d "$dir/_darcs") {
  68             darcs (@_, "--repodir", $dir);
  69         }
  70         else {
  71             message "== $dir not present or not a repository; skipping";
  72         }
  73     }
  74     for my $pkg (`cat libraries/boot-packages libraries/extra-packages`) {
  75         chomp $pkg;
  76         if (-d "libraries/$pkg") {
  77             darcs (@_, "--repodir", "libraries/$pkg");
  78         }
  79         else {
  80             warning("$pkg doesn't exist, use 'darcs-all get' to get it");
  81         }
  82     }
  83 }
  84
  85 sub darcsgetpackage {
  86     my ($get_it, $r_flags, $repo_root, $package) = @_;
  87
  88     if ($get_it) {
  89         if (-d $package) {
  90             warning("$package already present; omitting");
  91         }
  92         else {
  93             darcs (@$r_flags, "$repo_root/$package");
  94         }
  95     }
  96 }
  97
  98 sub darcsget {
  99     my $r_flags;
 100     if (! grep /(?:--complete|--partial)/, @_) {
 101         warning("adding --partial, to override use --complete");
 102         $r_flags = [@_, "--partial"];
 103     }
 104     else {
 105         $r_flags = \@_;
 106     }
 107
 108     darcsgetpackage($nofib,     $r_flags, $defaultrepo_base, "nofib");
 109     darcsgetpackage($testsuite, $r_flags, $defaultrepo_base, "testsuite");
 110
 111     chdir "libraries";
 112
 113     my @packages;
 114     if ($extra) {
 115         @packages = `cat boot-packages extra-packages`;
 116     }
 117     else {
 118         @packages = `cat boot-packages`;
 119     }
 120
 121     for my $pkg (@packages) {
 122         chomp $pkg;
 123         darcsgetpackage(1, $r_flags, $defaultrepo_lib, $pkg);
 124     }
 125 }
 126
 127 sub main {
 128     if (! -d "_darcs" || ! -d "compiler") {
 129         die "error: darcs-all must be run from the top level of the ghc tree."
 130     }
 131
 132     while ($#_ ne -1) {
 133         my $arg = shift;
 134         # We handle -q here as well as lower down as we need to skip over it
 135         # if it comes before the darcs command
 136         if ($arg eq "-q") {
 137             $verbose = 1;
 138         }
 139         elsif ($arg eq "-s") {
 140             $verbose = 0;
 141         }
 142         elsif ($arg eq "--extra") {
 143             $extra = 1;
 144         }
 145         elsif ($arg eq "--nofib") {
 146             $nofib = 1;
 147         }
 148         elsif ($arg eq "--testsuite") {
 149             $testsuite = 1;
 150         }
 151         else {
 152             unshift @_, $arg;
 153             if (grep /^-q$/, @_) {
 154                 $verbose = 1;
 155             }
 156             last;
 157         }
 158     }
 159
 160     if ($#_ eq -1) {
 161         die "What do you want to do?";
 162     }
 163     my $command = $_[0];
 164     if ($command eq "get") {
 165         darcsget @_;
 166     }
 167     else {
 168         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 169             # Hack around whatsnew failing if there are no changes
 170             $ignore_failure = 1;
 171         }
 172         darcsall @_;
 173     }
 174 }
 175
 176 main(@ARGV);
 177