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