c97729dfe9fb137f38edbb71271596b513e5438d
[ghc.git] / darcs-all
1 #!/usr/bin/perl -w
2
3 use strict;
4
5 # Usage:
6 #
7 # ./darcs-all [-q] [-s] [-i] [-r repo]
8 #             [--nofib] [--testsuite] [--checked-out] cmd [darcs flags]
9 #
10 # Applies the darcs command "cmd" to each repository in the tree.
11 #
12 # e.g.
13 #      ./darcs-all -r http://darcs.haskell.org/ghc get
14 #          To get any repos which do not exist in the local tree
15 #
16 #      ./darcs-all -r ~/ghc-validate push
17 #          To push all your repos to the ~/ghc-validate tree
18 #
19 #      ./darcs-all pull -a
20 #          To pull everything from the default repos
21 #
22 #      ./darc-all push --dry-run
23 #          To see what local patches you have relative to the main repos
24 #
25 # -------------- Flags -------------------
26 #   -q says to be quite, and -s to be silent.
27 #
28 #   -i says to ignore darcs errors and move on to the next repository
29 #
30 #   -r repo says to use repo as the location of package repositories
31 #
32 #   --checked-out says that the remote repo is in checked-out layout, as
33 #   opposed to the layout used for the main repo.  By default a repo on
34 #   the local filesystem is assumed to be checked-out, and repos accessed
35 #   via HTTP or SSH are assumed to be in the main repo layout; use
36 #   --checked-out to override the latter.
37 #
38 #   --nofib, --testsuite also get the nofib and testsuite repos respectively
39 #
40 #   The darcs get flag you are most likely to want is --complete. By
41 #   default we pass darcs the --partial flag.
42 #
43 # ------------ Which repos to use -------------
44 # darcs-all uses the following algorithm to decide which remote repos to use
45 #
46 #  It always computes the remote repos from a single base, $repo_base
47 #  How is $repo_base set?  
48 #    If you say "-r repo", then that's $repo_base
49 #    othewise $repo_base is set thus:
50 #       look in _darcs/prefs/defaultrepo, 
51 #       and remove the trailing 'ghc'
52 #
53 #  Then darcs-all iterates over the package found in the file
54 #  ./packages, which has entries like:
55 #         libraries/array  packages/array  darcs
56 #    or, in general
57 #         <local-path>  <remote-path> <vcs>
58
59 #    If $repo_base looks like a local filesystem path, or if you give
60 #    the --checked-out flag, darcs-all works on repos of form
61 #          $repo_base/<local-path>
62 #    otherwise darcs-all works on repos of form
63 #          $repo_base/<remote-path>
64 #    This logic lets you say
65 #      both    darcs-all -r http://darcs.haskell.org/ghc-6.12 pull
66 #      and     darcs-all -r ../HEAD pull
67 #    The latter is called a "checked-out tree".
68
69 # NB: darcs-all *ignores* the defaultrepo of all repos other than the
70 # root one.  So the remote repos must be laid out in one of the two
71 # formats given by <local-path> and <remote-path> in the file 'packages'.
72
73
74 $| = 1; # autoflush stdout after each print, to avoid output after die
75
76 my $defaultrepo;
77
78 my $verbose = 2;
79 my $ignore_failure = 0;
80 my $want_remote_repo = 0;
81 my $checked_out_flag = 0;
82
83 my %tags;
84
85 # Figure out where to get the other repositories from.
86 sub getrepo {
87     my $basedir = ".";
88     my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
89     chomp $repo;
90
91     my $repo_base;
92     my $checked_out_tree;
93
94     if ($repo =~ /^...*:/) {
95         # HTTP or SSH
96         # Above regex says "at least two chars before the :", to avoid
97         # catching Win32 drives ("C:\").
98         $repo_base = $repo;
99
100         # --checked-out is needed if you want to use a checked-out repo
101         # over SSH or HTTP
102         if ($checked_out_flag) {
103             $checked_out_tree = 1;
104         } else {
105             $checked_out_tree = 0;
106         }
107
108         # Don't drop the last part of the path if specified with -r, as
109         # it expects repos of the form:
110         #
111         #   http://darcs.haskell.org
112         #
113         # rather than
114         #   
115         #   http://darcs.haskell.org/ghc
116         #
117         if (!$defaultrepo) {
118             $repo_base =~ s#/[^/]+/?$##;
119         }
120     }
121     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
122         # Local filesystem, either absolute or relative path
123         # (assumes a checked-out tree):
124         $repo_base = $repo;
125         $checked_out_tree = 1;
126     }
127     else {
128         die "Couldn't work out repo";
129     }
130
131     return $repo_base, $checked_out_tree;
132 }
133
134 sub message {
135     if ($verbose >= 2) {
136         print "@_\n";
137     }
138 }
139
140 sub warning {
141     if ($verbose >= 1) {
142         print "warning: @_\n";
143     }
144 }
145
146 sub darcs {
147     message "== running darcs @_";
148     system ("darcs", @_) == 0
149        or $ignore_failure
150        or die "darcs failed: $?";
151 }
152
153 sub darcsall {
154     my $localpath;
155     my $remotepath;
156     my $path;
157     my $tag;
158     my @repos;
159     my $command = $_[0];
160
161     my ($repo_base, $checked_out_tree) = getrepo();
162
163     open IN, "< packages" or die "Can't open packages file";
164     @repos = <IN>;
165     close IN;
166
167     foreach (@repos) {
168         chomp;
169         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
170             $localpath = $1;
171             $tag = defined($2) ? $2 : "";
172             $remotepath = $3;
173
174             if ($checked_out_tree) {
175                 $path = "$repo_base/$localpath";
176             }
177             else {
178                 $path = "$repo_base/$remotepath";
179             }
180
181             if (-d "$localpath/_darcs") {
182                 if ($want_remote_repo) {
183                     if ($command =~ /^opt/) {
184                         # Allows ./darcs-all optimize --relink
185                         darcs (@_, "--repodir", $localpath, "--sibling=$path");
186                     } else {
187                         darcs (@_, "--repodir", $localpath, $path);
188                     }
189                 } else {
190                     darcs (@_, "--repodir", $localpath);
191                 }
192             }
193             elsif ($tag eq "") {
194                 message "== Required repo $localpath is missing! Skipping";
195             }
196             else {
197                 message "== $localpath repo not present; skipping";
198             }
199         }
200         elsif (! /^(#.*)?$/) {
201             die "Bad line: $_";
202         }
203     }
204 }
205
206 sub darcsget {
207     my $r_flags;
208     my $localpath;
209     my $remotepath;
210     my $path;
211     my $tag;
212     my @repos;
213
214     my ($repo_base, $checked_out_tree) = getrepo();
215
216     if (! grep /(?:--complete|--partial|--lazy)/, @_) {
217         warning("adding --partial, to override use --complete");
218         $r_flags = [@_, "--partial"];
219     }
220     else {
221         $r_flags = \@_;
222     }
223
224     open IN, "< packages" or die "Can't open packages file";
225     @repos = <IN>;
226     close IN;
227
228     foreach (@repos) {
229         chomp;
230         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
231             $localpath = $1;
232             $tag = defined($2) ? $2 : "";
233             $remotepath = $3;
234
235             if ($checked_out_tree) {
236                 $path = "$repo_base/$localpath";
237             }
238             else {
239                 $path = "$repo_base/$remotepath";
240             }
241
242             if (($tag eq "") || defined($tags{$tag})) {
243                 if (-d $localpath) {
244                     warning("$localpath already present; omitting");
245                 }
246                 else {
247                     darcs (@$r_flags, $path, $localpath);
248                 }
249             }
250         }
251         elsif (! /^(#.*)?$/) {
252             die "Bad line: $_";
253         }
254     }
255 }
256
257 sub main {
258     if (! -d "compiler") {
259         die "error: darcs-all must be run from the top level of the ghc tree."
260     }
261
262     while ($#_ ne -1) {
263         my $arg = shift;
264         # We handle -q here as well as lower down as we need to skip over it
265         # if it comes before the darcs command
266         if ($arg eq "-q") {
267             $verbose = 1;
268         }
269         elsif ($arg eq "-s") {
270             $verbose = 0;
271         }
272         elsif ($arg eq "-r") {
273             $defaultrepo = shift;
274         }
275         elsif ($arg eq "-i") {
276             $ignore_failure = 1;
277         }
278         # --nofib tells get to also grab the nofib repo.
279         # It has no effect on the other commands.
280         elsif ($arg eq "--nofib") {
281             $tags{"nofib"} = 1;
282         }
283         # --testsuite tells get to also grab the testsuite repo.
284         # It has no effect on the other commands.
285         elsif ($arg eq "--testsuite") {
286             $tags{"testsuite"} = 1;
287         }
288         # --extralibs tells get to also grab the extra repos.
289         # It has no effect on the other commands.
290         elsif ($arg eq "--extra") {
291             $tags{"extra"} = 1;
292         }
293         elsif ($arg eq "--checked-out") {
294             $checked_out_flag = 1;
295         }
296         else {
297             unshift @_, $arg;
298             if (grep /^-q$/, @_) {
299                 $verbose = 1;
300             }
301             last;
302         }
303     }
304
305     if ($#_ eq -1) {
306         die "What do you want to do?";
307     }
308     my $command = $_[0];
309     if ($command eq "get") {
310         darcsget @_;
311     }
312     else {
313         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
314             # Hack around whatsnew failing if there are no changes
315             $ignore_failure = 1;
316         }
317         if ($command =~ /^(pul|pus|sen|put|opt)/) {
318             $want_remote_repo = 1;
319         }
320         darcsall @_;
321     }
322 }
323
324 END {
325     message "== Checking for old bytestring repo";
326     if (-d "libraries/bytestring/_darcs") {
327         if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
328             print <<EOF;
329 ============================
330 ATTENTION!
331
332 You have an old bytestring repository in your GHC tree!
333
334 Please remove it (e.g. "rm -r libraries/bytestring"), and the new
335 version of bytestring will be used from a tarball instead.
336 ============================
337 EOF
338         }
339     }
340
341     message "== Checking for unpulled tarball patches";
342     if ((system "darcs annotate --match 'hash 20090930200358-3fd76-cab3bf4a0a9e3902eb6dd41f71712ad3a6a9bcd1' > /dev/null 2> /dev/null") == 0) {
343         print <<EOF;
344 ============================
345 ATTENTION!
346
347 You have the unpulled tarball patches in your GHC tree!
348
349 Please remove them:
350     darcs unpull -p "Use mingw tarballs to get mingw on Windows"
351 and say yes to each patch.
352 ============================
353 EOF
354     }
355 }
356
357 main(@ARGV);
358