Refine incomplete-pattern checks (Trac #4905)
[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 my @packages;
86
87 # Figure out where to get the other repositories from.
88 sub getrepo {
89     my $basedir = ".";
90     my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
91     chomp $repo;
92
93     my $repo_base;
94     my $checked_out_tree;
95
96     if ($repo =~ /^...*:/) {
97         # HTTP or SSH
98         # Above regex says "at least two chars before the :", to avoid
99         # catching Win32 drives ("C:\").
100         $repo_base = $repo;
101
102         # --checked-out is needed if you want to use a checked-out repo
103         # over SSH or HTTP
104         if ($checked_out_flag) {
105             $checked_out_tree = 1;
106         } else {
107             $checked_out_tree = 0;
108         }
109
110         # Don't drop the last part of the path if specified with -r, as
111         # it expects repos of the form:
112         #
113         #   http://darcs.haskell.org
114         #
115         # rather than
116         #   
117         #   http://darcs.haskell.org/ghc
118         #
119         if (!$defaultrepo) {
120             $repo_base =~ s#/[^/]+/?$##;
121         }
122     }
123     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
124         # Local filesystem, either absolute or relative path
125         # (assumes a checked-out tree):
126         $repo_base = $repo;
127         $checked_out_tree = 1;
128     }
129     else {
130         die "Couldn't work out repo";
131     }
132
133     return $repo_base, $checked_out_tree;
134 }
135
136 sub message {
137     if ($verbose >= 2) {
138         print "@_\n";
139     }
140 }
141
142 sub warning {
143     if ($verbose >= 1) {
144         print "warning: @_\n";
145     }
146 }
147
148 sub darcs {
149     message "== running darcs @_";
150     system ("darcs", @_) == 0
151        or $ignore_failure
152        or die "darcs failed: $?";
153 }
154
155 sub parsePackages {
156     my @repos;
157     my $lineNum;
158
159     my ($repo_base, $checked_out_tree) = getrepo();
160
161     open IN, "< packages" or die "Can't open packages file";
162     @repos = <IN>;
163     close IN;
164
165     @packages = ();
166     $lineNum = 0;
167     foreach (@repos) {
168         chomp;
169         $lineNum++;
170         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
171             my %line;
172             $line{"localpath"}  = $1;
173             $line{"tag"}        = $2;
174             $line{"remotepath"} = $3;
175             $line{"vcs"}        = $4;
176             $line{"upstream"}   = $5;
177             push @packages, \%line;
178         }
179         elsif (! /^(#.*)?$/) {
180             die "Bad content on line $lineNum of packages file: $_";
181         }
182     }
183 }
184
185 sub darcsall {
186     my $localpath;
187     my $remotepath;
188     my $path;
189     my $tag;
190     my @repos;
191     my $command = $_[0];
192     my $line;
193
194     my ($repo_base, $checked_out_tree) = getrepo();
195
196     for $line (@packages) {
197         $localpath  = $$line{"localpath"};
198         $tag        = $$line{"tag"};
199         $remotepath = $$line{"remotepath"};
200
201         if ($checked_out_tree) {
202             $path = "$repo_base/$localpath";
203         }
204         else {
205             $path = "$repo_base/$remotepath";
206         }
207
208         if (-d "$localpath/_darcs") {
209             if ($want_remote_repo) {
210                 if ($command =~ /^opt/) {
211                     # Allows ./darcs-all optimize --relink
212                     darcs (@_, "--repodir", $localpath, "--sibling=$path");
213                 } else {
214                     darcs (@_, "--repodir", $localpath, $path);
215                 }
216             } else {
217                 darcs (@_, "--repodir", $localpath);
218             }
219         }
220         elsif ($tag eq "-") {
221             message "== Required repo $localpath is missing! Skipping";
222         }
223         else {
224             message "== $localpath repo not present; skipping";
225         }
226     }
227 }
228
229 sub darcsget {
230     my $r_flags;
231     my $localpath;
232     my $remotepath;
233     my $path;
234     my $tag;
235     my @repos;
236     my $line;
237
238     my ($repo_base, $checked_out_tree) = getrepo();
239
240     if (! grep /(?:--complete|--partial|--lazy)/, @_) {
241         warning("adding --partial, to override use --complete");
242         $r_flags = [@_, "--partial"];
243     }
244     else {
245         $r_flags = \@_;
246     }
247
248     for $line (@packages) {
249         $localpath  = $$line{"localpath"};
250         $tag        = $$line{"tag"};
251         $remotepath = $$line{"remotepath"};
252
253         if ($checked_out_tree) {
254             $path = "$repo_base/$localpath";
255         }
256         else {
257             $path = "$repo_base/$remotepath";
258         }
259
260         if ($tags{$tag} eq 1) {
261             if (-d $localpath) {
262                 warning("$localpath already present; omitting");
263             }
264             else {
265                 darcs (@$r_flags, $path, $localpath);
266             }
267         }
268     }
269 }
270
271 sub darcsupstreampull {
272     my $localpath;
273     my $upstream;
274     my $line;
275
276     for $line (@packages) {
277         $localpath  = $$line{"localpath"};
278         $upstream   = $$line{"upstream"};
279
280         if ($upstream ne "-") {
281             if (-d $localpath) {
282                 darcs ("pull", @_, "--repodir", $localpath, $upstream);
283             }
284         }
285     }
286 }
287
288 sub main {
289     if (! -d "compiler") {
290         die "error: darcs-all must be run from the top level of the ghc tree."
291     }
292
293     $tags{"-"} = 1;
294     $tags{"dph"} = 1;
295     $tags{"nofib"} = 0;
296     $tags{"testsuite"} = 0;
297     $tags{"extra"} = 0;
298
299     while ($#_ ne -1) {
300         my $arg = shift;
301         # We handle -q here as well as lower down as we need to skip over it
302         # if it comes before the darcs command
303         if ($arg eq "-q") {
304             $verbose = 1;
305         }
306         elsif ($arg eq "-s") {
307             $verbose = 0;
308         }
309         elsif ($arg eq "-r") {
310             $defaultrepo = shift;
311         }
312         elsif ($arg eq "-i") {
313             $ignore_failure = 1;
314         }
315         # --nofib tells get to also grab the nofib repo.
316         # It has no effect on the other commands.
317         elsif ($arg eq "--nofib") {
318             $tags{"nofib"} = 1;
319         }
320         elsif ($arg eq "--no-nofib") {
321             $tags{"nofib"} = 0;
322         }
323         # --testsuite tells get to also grab the testsuite repo.
324         # It has no effect on the other commands.
325         elsif ($arg eq "--testsuite") {
326             $tags{"testsuite"} = 1;
327         }
328         elsif ($arg eq "--no-testsuite") {
329             $tags{"testsuite"} = 0;
330         }
331         # --dph tells get to also grab the dph repo.
332         # It has no effect on the other commands.
333         elsif ($arg eq "--dph") {
334             $tags{"dph"} = 1;
335         }
336         elsif ($arg eq "--no-dph") {
337             $tags{"dph"} = 0;
338         }
339         # --extralibs tells get to also grab the extra repos.
340         # It has no effect on the other commands.
341         elsif ($arg eq "--extra") {
342             $tags{"extra"} = 1;
343         }
344         elsif ($arg eq "--no-extra") {
345             $tags{"extra"} = 0;
346         }
347         # Use --checked-out if the remote repos are a checked-out tree,
348         # rather than the master trees.
349         elsif ($arg eq "--checked-out") {
350             $checked_out_flag = 1;
351         }
352         else {
353             unshift @_, $arg;
354             if (grep /^-q$/, @_) {
355                 $verbose = 1;
356             }
357             last;
358         }
359     }
360
361     if ($#_ eq -1) {
362         die "What do you want to do?";
363     }
364     my $command = $_[0];
365     parsePackages;
366     if ($command eq "get") {
367         darcsget @_;
368     }
369     elsif ($command eq "upstreampull") {
370         shift;
371         darcsupstreampull @_;
372     }
373     else {
374         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
375             # Hack around whatsnew failing if there are no changes
376             $ignore_failure = 1;
377         }
378         if ($command =~ /^(pul|pus|sen|put|opt)/) {
379             $want_remote_repo = 1;
380         }
381         darcsall @_;
382     }
383 }
384
385 END {
386     my $ec = $?;
387
388     message "== Checking for old bytestring repo";
389     if (-d "libraries/bytestring/_darcs") {
390         if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
391             print <<EOF;
392 ============================
393 ATTENTION!
394
395 You have an old bytestring repository in your GHC tree!
396
397 Please remove it (e.g. "rm -r libraries/bytestring"), and the new
398 version of bytestring will be used from a tarball instead.
399 ============================
400 EOF
401         }
402     }
403
404     message "== Checking for bytestring tarball";
405     if (-d "libraries/bytestring" && not -d "libraries/bytestring/_darcs") {
406         print <<EOF;
407 ============================
408 ATTENTION!
409
410 You have an old bytestring in your GHC tree!
411
412 Please remove it (e.g. "rm -r libraries/bytestring"), and then run
413 "./darcs-all get" to get the darcs repository.
414 ============================
415 EOF
416     }
417
418     message "== Checking for unpulled tarball patches";
419     if ((system "darcs annotate --match 'hash 20090930200358-3fd76-cab3bf4a0a9e3902eb6dd41f71712ad3a6a9bcd1' > /dev/null 2> /dev/null") == 0) {
420         print <<EOF;
421 ============================
422 ATTENTION!
423
424 You have the unpulled tarball patches in your GHC tree!
425
426 Please remove them:
427     darcs unpull -p "Use mingw tarballs to get mingw on Windows"
428 and say yes to each patch.
429 ============================
430 EOF
431     }
432
433     $? = $ec;
434 }
435
436 main(@ARGV);
437