Ignore tags files.
[ghc-hetmet.git] / sync-all
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Cwd;
5
6 my $defaultrepo;
7 my @packages;
8 my $verbose = 2;
9 my $ignore_failure = 0;
10 my $want_remote_repo = 0;
11 my $checked_out_flag = 0;
12 my $get_mode;
13
14 # Flags specific to a particular command
15 my $local_repo_unnecessary = 0;
16
17 my %tags;
18
19 # Figure out where to get the other repositories from.
20 sub getrepo {
21     my $basedir = ".";
22     my $repo;
23
24     if (defined($defaultrepo)) {
25         $repo = $defaultrepo;
26         chomp $repo;
27     } else {
28         # Figure out where to get the other repositories from,
29         # based on where this GHC repo came from.
30         my $branch = `git branch | grep "\* " | sed "s/^\* //"`; chomp $branch;
31         my $remote = `git config branch.$branch.remote`;         chomp $remote;
32         $repo = `git config remote.$remote.url`;       chomp $repo;
33     }
34
35     my $repo_base;
36     my $checked_out_tree;
37
38     if ($repo =~ /^...*:/) {
39         # HTTP or SSH
40         # Above regex says "at least two chars before the :", to avoid
41         # catching Win32 drives ("C:\").
42         $repo_base = $repo;
43
44         # --checked-out is needed if you want to use a checked-out repo
45         # over SSH or HTTP
46         if ($checked_out_flag) {
47             $checked_out_tree = 1;
48         } else {
49             $checked_out_tree = 0;
50         }
51
52         # Don't drop the last part of the path if specified with -r, as
53         # it expects repos of the form:
54         #
55         #   http://darcs.haskell.org
56         #
57         # rather than
58         #   
59         #   http://darcs.haskell.org/ghc
60         #
61         if (!$defaultrepo) {
62             $repo_base =~ s#/[^/]+/?$##;
63         }
64     }
65     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
66         # Local filesystem, either absolute or relative path
67         # (assumes a checked-out tree):
68         $repo_base = $repo;
69         $checked_out_tree = 1;
70     }
71     else {
72         die "Couldn't work out repo";
73     }
74
75     return $repo_base, $checked_out_tree;
76 }
77
78 sub parsePackages {
79     my @repos;
80     my $lineNum;
81
82     open IN, "< packages" or die "Can't open packages file";
83     @repos = <IN>;
84     close IN;
85
86     @packages = ();
87     $lineNum = 0;
88     foreach (@repos) {
89         chomp;
90         $lineNum++;
91         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
92             my %line;
93             $line{"localpath"}  = $1;
94             $line{"tag"}        = $2;
95             $line{"remotepath"} = $3;
96             $line{"vcs"}        = $4;
97             $line{"upstream"}   = $5;
98             push @packages, \%line;
99         }
100         elsif (! /^(#.*)?$/) {
101             die "Bad content on line $lineNum of packages file: $_";
102         }
103     }
104 }
105
106 sub message {
107     if ($verbose >= 2) {
108         print "@_\n";
109     }
110 }
111
112 sub warning {
113     if ($verbose >= 1) {
114         print "warning: @_\n";
115     }
116 }
117
118 sub scm {
119     my $dir = shift;
120     my $scm = shift;
121     my $pwd;
122
123     if ($dir eq '.') {
124         message "== running $scm @_";
125     } else {
126         message "== $dir: running $scm @_";
127         $pwd = getcwd();
128         chdir($dir);
129     }
130
131     system ($scm, @_) == 0
132         or $ignore_failure
133         or die "$scm failed: $?";
134
135     if ($dir ne '.') {
136         chdir($pwd);
137     }
138 }
139
140 sub repoexists {
141     my ($scm, $localpath) = @_;
142     
143     if ($scm eq "darcs") {
144         -d "$localpath/_darcs";
145     }
146     else {
147         -d "$localpath/.git";
148     }
149 }
150
151 sub scmall {
152     my $command = shift;
153     
154     my $localpath;
155     my $tag;
156     my $remotepath;
157     my $scm;
158     my $upstream;
159     my $line;
160
161     my $path;
162     my $wd_before = getcwd;
163
164     my @scm_args;
165
166     my $pwd;
167
168     my ($repo_base, $checked_out_tree) = getrepo();
169
170     parsePackages;
171
172     for $line (@packages) {
173
174             $localpath  = $$line{"localpath"};
175             $tag        = $$line{"tag"};
176             $remotepath = $$line{"remotepath"};
177             $scm        = $$line{"vcs"};
178             $upstream   = $$line{"upstream"};
179
180             # Check the SCM is OK as early as possible
181             die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
182
183             # Work out the path for this package in the repo we pulled from
184             if ($checked_out_tree) {
185                 $path = "$repo_base/$localpath";
186             }
187             else {
188                 $path = "$repo_base/$remotepath";
189             }
190
191             # Work out the arguments we should give to the SCM
192             if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
193                 @scm_args = (($scm eq "darcs" and "whatsnew")
194                           or ($scm eq "git" and "status"));
195                 
196                 # Hack around 'darcs whatsnew' failing if there are no changes
197                 $ignore_failure = 1;
198             }
199             elsif ($command =~ /^(?:pus|push)$/) {
200                 @scm_args = "push";
201                 $want_remote_repo = 1;
202             }
203             elsif ($command =~ /^(?:pul|pull)$/) {
204                 @scm_args = "pull";
205                 $want_remote_repo = 1;
206                 # Q: should we append the -a argument for darcs repos?
207             }
208             elsif ($command =~ /^(?:g|ge|get)$/) {
209                 # Skip any repositories we have not included the tag for
210                 if (not defined($tags{$tag})) {
211                     next;
212                 }
213                 
214                 if (-d $localpath) {
215                     warning("$localpath already present; omitting") if $localpath ne ".";
216                     next;
217                 }
218                 
219                 # The first time round the loop, default the get-mode
220                 if (not defined($get_mode)) {
221                     warning("adding --partial, to override use --complete");
222                     $get_mode = "--partial";
223                 }
224                 
225                 # The only command that doesn't need a repo
226                 $local_repo_unnecessary = 1;
227                 
228                 if ($scm eq "darcs") {
229                     # Note: we can only use the get-mode with darcs for now
230                     @scm_args = ("get", $get_mode, $path, $localpath);
231                 }
232                 else {
233                     @scm_args = ("clone", $path, $localpath);
234                 }
235             }
236             elsif ($command =~ /^(?:s|se|sen|send)$/) {
237                 @scm_args = (($scm eq "darcs" and "send")
238                           or ($scm eq "git" and "send-email"));
239                 $want_remote_repo = 1;
240             }
241             elsif ($command =~ /^set-origin$/) {
242                 @scm_args = ("remote", "set-url", "origin", $path);
243             }
244             elsif ($command =~ /^set-push$/) {
245                 @scm_args = ("remote", "set-url", "--push", "origin", $path);
246                 print "foo\n", @scm_args;
247             }
248             elsif ($command =~ /^fetch$/) {
249                 @scm_args = ("fetch", "origin");
250             }
251             elsif ($command =~ /^new$/) {
252                 @scm_args = ("log", "origin..");
253             }
254             else {
255                 die "Unknown command: $command";
256             }
257             
258             # Actually execute the command
259             if (repoexists ($scm, $localpath)) {
260                 if ($want_remote_repo) {
261                     if ($scm eq "darcs") {
262                         scm (".", $scm, @scm_args, @_, "--repodir=$localpath", $path);
263                     } else {
264                         # git pull doesn't like to be used with --work-dir
265                         # I couldn't find an alternative to chdir() here
266                         scm ($localpath, $scm, @scm_args, @_, $path, "master");
267                     }
268                 } else {
269                     # git status *must* be used with --work-dir, if we don't chdir() to the dir
270                     scm ($localpath, $scm, @scm_args, @_);
271                 }
272             }
273             elsif ($local_repo_unnecessary) {
274                 # Don't bother to change directory in this case
275                 scm (".", $scm, @scm_args, @_);
276             }
277             elsif ($tag eq "") {
278                 message "== Required repo $localpath is missing! Skipping";
279             }
280             else {
281                 message "== $localpath repo not present; skipping";
282             }
283     }
284 }
285
286 sub main {
287     if (! -d ".git" || ! -d "compiler") {
288         die "error: sync-all must be run from the top level of the ghc tree."
289     }
290
291     $tags{"-"} = 1;
292     $tags{"dph"} = 1;
293
294     while ($#_ ne -1) {
295         my $arg = shift;
296         # We handle -q here as well as lower down as we need to skip over it
297         # if it comes before the source-control command
298         if ($arg eq "-q") {
299             $verbose = 1;
300         }
301         elsif ($arg eq "-s") {
302             $verbose = 0;
303         }
304         elsif ($arg eq "-r") {
305             $defaultrepo = shift;
306         }
307         elsif ($arg eq "--ignore-failure") {
308             $ignore_failure = 1;
309         }
310         elsif ($arg eq "--complete" || $arg eq "--partial") {
311             $get_mode = $arg;
312         }
313         # Use --checked-out if the remote repos are a checked-out tree,
314         # rather than the master trees.
315         elsif ($arg eq "--checked-out") {
316             $checked_out_flag = 1;
317         }
318         # --<tag> says we grab the libs tagged 'tag' with
319         # 'get'. It has no effect on the other commands.
320         elsif ($arg =~ m/^--/) {
321             $arg =~ s/^--//;
322             $tags{$arg} = 1;
323         }
324         else {
325             unshift @_, $arg;
326             if (grep /^-q$/, @_) {
327                 $verbose = 1;
328             }
329             last;
330         }
331     }
332
333     if ($#_ eq -1) {
334         # Get the built in help
335         my $help = <<END;
336 What do you want to do?
337 Supported commands:
338
339  * whatsnew
340  * push
341  * pull
342  * get, with options:
343   * --<package-tag>
344   * --complete
345   * --partial
346  * fetch
347  * send
348  * set-origin
349  * set-push
350  * new
351
352 Available package-tags are:
353 END
354
355         # Collect all the tags in the packages file
356         my %available_tags;
357         open IN, "< packages" or die "Can't open packages file";
358         while (<IN>) {
359             chomp;
360             if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
361                 if (defined($2) && $2 ne "-") {
362                     $available_tags{$2} = 1;
363                 }
364             }
365             elsif (! /^(#.*)?$/) {
366                 die "Bad line: $_";
367             }
368         }
369         close IN;
370         
371         # Show those tags and the help text
372         my @available_tags = keys %available_tags;
373         print "$help@available_tags\n";
374         exit 1;
375     }
376     else {
377         # Give the command and rest of the arguments to the main loop
378         scmall @_;
379     }
380 }
381
382 main(@ARGV);
383