Rejig how darcs-all works
[ghc.git] / 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
59     darcs @_;
60
61     open IN, "< packages" or die "Can't open packages file";
62     while (<IN>) {
63         chomp;
64         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+)/) {
65             $localpath = $1;
66             $tag = defined($2) ? $2 : "";
67
68             if (-d "$localpath/_darcs") {
69                 darcs (@_, "--repodir", $localpath);
70             }
71             elsif ($tag eq "") {
72                 message "== Required repo $localpath is missing! Skipping";
73             }
74             else {
75                 message "== $localpath repo not present; skipping";
76             }
77         }
78         elsif (! /^$/) {
79             die "Bad line: $_";
80         }
81     }
82     close IN;
83 }
84
85 sub darcsget {
86     my $r_flags;
87     my $localpath;
88     my $remotepath;
89     my $path;
90     my $tag;
91
92     if (! grep /(?:--complete|--partial)/, @_) {
93         warning("adding --partial, to override use --complete");
94         $r_flags = [@_, "--partial"];
95     }
96     else {
97         $r_flags = \@_;
98     }
99
100     open IN, "< packages" or die "Can't open packages file";
101     while (<IN>) {
102         chomp;
103         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+)/) {
104             $localpath = $1;
105             $tag = defined($2) ? $2 : "";
106             $remotepath = $3;
107
108             if ($checked_out_tree) {
109                 $path = "$defaultrepo_base/$localpath";
110             }
111             else {
112                 $path = "$defaultrepo_base/$remotepath";
113             }
114
115             if (($tag eq "") || defined($tags{$tag})) {
116                 if (-d $localpath) {
117                     warning("$localpath already present; omitting");
118                 }
119                 else {
120                     darcs (@$r_flags, $path, $localpath);
121                 }
122             }
123         }
124         elsif (! /^$/) {
125             die "Bad line: $_";
126         }
127     }
128     close IN;
129 }
130
131 sub main {
132     if (! -d "_darcs" || ! -d "compiler") {
133         die "error: darcs-all must be run from the top level of the ghc tree."
134     }
135
136     while ($#_ ne -1) {
137         my $arg = shift;
138         # We handle -q here as well as lower down as we need to skip over it
139         # if it comes before the darcs command
140         if ($arg eq "-q") {
141             $verbose = 1;
142         }
143         elsif ($arg eq "-s") {
144             $verbose = 0;
145         }
146         # --ci says we grab cabal-install repo, and the libraries it needs
147         # with 'get'.
148         # It has no effect on the other commands.
149         elsif ($arg eq "--ci") {
150             $tags{"ci"} = 1;
151         }
152         # --extra says we grab the extra libs with 'get'.
153         # It has no effect on the other commands.
154         elsif ($arg eq "--extra") {
155             $tags{"extralibs"} = 1;
156         }
157         # --nofib tells get to also grab the nofib repo.
158         # It has no effect on the other commands.
159         elsif ($arg eq "--nofib") {
160             $tags{"nofib"} = 1;
161         }
162         # --testsuite tells get to also grab the testsuite repo.
163         # It has no effect on the other commands.
164         elsif ($arg eq "--testsuite") {
165             $tags{"testsuite"} = 1;
166         }
167         else {
168             unshift @_, $arg;
169             if (grep /^-q$/, @_) {
170                 $verbose = 1;
171             }
172             last;
173         }
174     }
175
176     if ($#_ eq -1) {
177         die "What do you want to do?";
178     }
179     my $command = $_[0];
180     if ($command eq "get") {
181         darcsget @_;
182     }
183     else {
184         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
185             # Hack around whatsnew failing if there are no changes
186             $ignore_failure = 1;
187         }
188         darcsall @_;
189     }
190 }
191
192 main(@ARGV);
193