0462930a0785a4a4d78f71520888144d551989d0
[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         # --dph says we grab the dph libs with 'get'.
147         # It has no effect on the other commands.
148         elsif ($arg eq "--dph") {
149             $tags{"dph"} = 1;
150         }
151         # --extra says we grab the extra libs with 'get'.
152         # It has no effect on the other commands.
153         elsif ($arg eq "--extra") {
154             $tags{"extralibs"} = 1;
155         }
156         # --nofib tells get to also grab the nofib repo.
157         # It has no effect on the other commands.
158         elsif ($arg eq "--nofib") {
159             $tags{"nofib"} = 1;
160         }
161         # --testsuite tells get to also grab the testsuite repo.
162         # It has no effect on the other commands.
163         elsif ($arg eq "--testsuite") {
164             $tags{"testsuite"} = 1;
165         }
166         else {
167             unshift @_, $arg;
168             if (grep /^-q$/, @_) {
169                 $verbose = 1;
170             }
171             last;
172         }
173     }
174
175     if ($#_ eq -1) {
176         die "What do you want to do?";
177     }
178     my $command = $_[0];
179     if ($command eq "get") {
180         darcsget @_;
181     }
182     else {
183         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
184             # Hack around whatsnew failing if there are no changes
185             $ignore_failure = 1;
186         }
187         darcsall @_;
188     }
189 }
190
191 main(@ARGV);
192