darcs-all

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