darcs-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 # Figure out where to get the other repositories from,
   6 # based on where this GHC repo came from.
   7 my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
   8 chomp $defaultrepo;
   9 my $defaultrepo_base;
  10 my $checked_out_tree;
  11
  12 if ($defaultrepo =~ /^...*:/) {
  13     # HTTP or SSH
  14     # Above regex says "at least two chars before the :", to avoid
  15     # catching Win32 drives ("C:\").
  16     $defaultrepo_base = $defaultrepo;
  17     $defaultrepo_base =~ s#/[^/]+/?$##;
  18     $checked_out_tree = 0;
  19 }
  20 elsif ($defaultrepo =~ /^\/|\.\.\/|.:(\/|\\)/) {
  21     # Local filesystem, either absolute or relative path
  22     # (assumes a checked-out tree):
  23     $defaultrepo_base = $defaultrepo;
  24     $checked_out_tree = 1;
  25 }
  26 else {
  27     die "Couldn't work out defaultrepo";
  28 }
  29
  30 my $verbose = 2;
  31 my $ignore_failure = 0;
  32
  33 my %tags;
  34
  35 sub message {
  36     if ($verbose >= 2) {
  37         print "@_\n";
  38     }
  39 }
  40
  41 sub warning {
  42     if ($verbose >= 1) {
  43         print "warning: @_\n";
  44     }
  45 }
  46
  47 sub darcs {
  48     message "== running darcs @_";
  49     system ("darcs", @_) == 0
  50         or $ignore_failure
  51         or die "darcs failed: $?";
  52 }
  53
  54 sub darcsall {
  55     my $localpath;
  56     my $path;
  57     my $tag;
  58     my @repos;
  59
  60     open IN, "< packages" or die "Can't open packages file";
  61     @repos = <IN>;
  62     close IN;
  63
  64     foreach (@repos) {
  65         chomp;
  66         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
  67             $localpath = $1;
  68             $tag = defined($2) ? $2 : "";
  69
  70             if (-d "$localpath/_darcs") {
  71                 darcs (@_, "--repodir", $localpath);
  72             }
  73             elsif ($tag eq "") {
  74                 message "== Required repo $localpath is missing! Skipping";
  75             }
  76             else {
  77                 message "== $localpath repo not present; skipping";
  78             }
  79         }
  80         elsif (! /^(#.*)?$/) {
  81             die "Bad line: $_";
  82         }
  83     }
  84 }
  85
  86 sub darcsget {
  87     my $r_flags;
  88     my $localpath;
  89     my $remotepath;
  90     my $path;
  91     my $tag;
  92     my @repos;
  93
  94     if (! grep /(?:--complete|--partial)/, @_) {
  95         warning("adding --partial, to override use --complete");
  96         $r_flags = [@_, "--partial"];
  97     }
  98     else {
  99         $r_flags = \@_;
 100     }
 101
 102     open IN, "< packages" or die "Can't open packages file";
 103     @repos = <IN>;
 104     close IN;
 105
 106     foreach (@repos) {
 107         chomp;
 108         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
 109             $localpath = $1;
 110             $tag = defined($2) ? $2 : "";
 111             $remotepath = $3;
 112
 113             if ($checked_out_tree) {
 114                 $path = "$defaultrepo_base/$localpath";
 115             }
 116             else {
 117                 if ($remotepath =~ /^http:/) {
 118                     $path = $remotepath;
 119                 }
 120                 else {
 121                     $path = "$defaultrepo_base/$remotepath";
 122                 }
 123             }
 124
 125             if (($tag eq "") || defined($tags{$tag})) {
 126                 if (-d $localpath) {
 127                     warning("$localpath already present; omitting");
 128                 }
 129                 else {
 130                     darcs (@$r_flags, $path, $localpath);
 131                 }
 132             }
 133         }
 134         elsif (! /^(#.*)?$/) {
 135             die "Bad line: $_";
 136         }
 137     }
 138 }
 139
 140 sub main {
 141     if (! -d "_darcs" || ! -d "compiler") {
 142         die "error: darcs-all must be run from the top level of the ghc tree."
 143     }
 144
 145     while ($#_ ne -1) {
 146         my $arg = shift;
 147         # We handle -q here as well as lower down as we need to skip over it
 148         # if it comes before the darcs command
 149         if ($arg eq "-q") {
 150             $verbose = 1;
 151         }
 152         elsif ($arg eq "-s") {
 153             $verbose = 0;
 154         }
 155         # --dph says we grab the dph libs with 'get'.
 156         # It has no effect on the other commands.
 157         elsif ($arg eq "--dph") {
 158             $tags{"dph"} = 1;
 159         }
 160         # --extra says we grab the extra libs with 'get'.
 161         # It has no effect on the other commands.
 162         elsif ($arg eq "--extra") {
 163             $tags{"extralibs"} = 1;
 164         }
 165         # --nofib tells get to also grab the nofib repo.
 166         # It has no effect on the other commands.
 167         elsif ($arg eq "--nofib") {
 168             $tags{"nofib"} = 1;
 169         }
 170         # --testsuite tells get to also grab the testsuite repo.
 171         # It has no effect on the other commands.
 172         elsif ($arg eq "--testsuite") {
 173             $tags{"testsuite"} = 1;
 174         }
 175         else {
 176             unshift @_, $arg;
 177             if (grep /^-q$/, @_) {
 178                 $verbose = 1;
 179             }
 180             last;
 181         }
 182     }
 183
 184     if ($#_ eq -1) {
 185         die "What do you want to do?";
 186     }
 187     my $command = $_[0];
 188     if ($command eq "get") {
 189         darcsget @_;
 190     }
 191     else {
 192         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 193             # Hack around whatsnew failing if there are no changes
 194             $ignore_failure = 1;
 195         }
 196         darcsall @_;
 197     }
 198 }
 199
 200 main(@ARGV);
 201