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