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