darcs-all

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