9 my $ignore_failure = 0;
10 my $want_remote_repo = 0;
11 my $checked_out_flag = 0;
14 # Flags specific to a particular command
15 my $local_repo_unnecessary = 0;
19 # Figure out where to get the other repositories from.
24 if (defined($defaultrepo)) {
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;
38 if ($repo =~ /^...*:/) {
40 # Above regex says "at least two chars before the :", to avoid
41 # catching Win32 drives ("C:\").
44 # --checked-out is needed if you want to use a checked-out repo
46 if ($checked_out_flag) {
47 $checked_out_tree = 1;
49 $checked_out_tree = 0;
52 # Don't drop the last part of the path if specified with -r, as
53 # it expects repos of the form:
55 # http://darcs.haskell.org
59 # http://darcs.haskell.org/ghc
62 $repo_base =~ s#/[^/]+/?$##;
65 elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
66 # Local filesystem, either absolute or relative path
67 # (assumes a checked-out tree):
69 $checked_out_tree = 1;
72 die "Couldn't work out repo";
75 return $repo_base, $checked_out_tree;
82 open IN, "< packages" or die "Can't open packages file";
91 if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
93 $line{"localpath"} = $1;
95 $line{"remotepath"} = $3;
97 $line{"upstream"} = $5;
98 push @packages, \%line;
100 elsif (! /^(#.*)?$/) {
101 die "Bad content on line $lineNum of packages file: $_";
114 print "warning: @_\n";
124 message "== running $scm @_";
126 message "== $dir: running $scm @_";
131 system ($scm, @_) == 0
133 or die "$scm failed: $?";
141 my ($scm, $localpath) = @_;
143 if ($scm eq "darcs") {
144 -d "$localpath/_darcs";
147 -d "$localpath/.git";
162 my $wd_before = getcwd;
168 my ($repo_base, $checked_out_tree) = getrepo();
172 for $line (@packages) {
174 $localpath = $$line{"localpath"};
175 $tag = $$line{"tag"};
176 $remotepath = $$line{"remotepath"};
177 $scm = $$line{"vcs"};
178 $upstream = $$line{"upstream"};
180 # Check the SCM is OK as early as possible
181 die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
183 # Work out the path for this package in the repo we pulled from
184 if ($checked_out_tree) {
185 $path = "$repo_base/$localpath";
188 $path = "$repo_base/$remotepath";
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"));
196 # Hack around 'darcs whatsnew' failing if there are no changes
199 elsif ($command =~ /^(?:pus|push)$/) {
201 $want_remote_repo = 1;
203 elsif ($command =~ /^(?:pul|pull)$/) {
205 $want_remote_repo = 1;
206 # Q: should we append the -a argument for darcs repos?
208 elsif ($command =~ /^(?:g|ge|get)$/) {
209 # Skip any repositories we have not included the tag for
210 if (not defined($tags{$tag})) {
215 warning("$localpath already present; omitting") if $localpath ne ".";
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";
225 # The only command that doesn't need a repo
226 $local_repo_unnecessary = 1;
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);
233 @scm_args = ("clone", $path, $localpath);
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;
241 elsif ($command =~ /^set-origin$/) {
242 @scm_args = ("remote", "set-url", "origin", $path);
244 elsif ($command =~ /^fetch$/) {
245 @scm_args = ("fetch", "origin");
247 elsif ($command =~ /^new$/) {
248 @scm_args = ("log", "origin..");
251 die "Unknown command: $command";
254 # Actually execute the command
255 if (repoexists ($scm, $localpath)) {
256 if ($want_remote_repo) {
257 if ($scm eq "darcs") {
258 scm (".", $scm, @scm_args, @_, "--repodir=$localpath", $path);
260 # git pull doesn't like to be used with --work-dir
261 # I couldn't find an alternative to chdir() here
262 scm ($localpath, $scm, @scm_args, @_, $path, "master");
265 # git status *must* be used with --work-dir, if we don't chdir() to the dir
266 scm ($localpath, $scm, @scm_args, @_);
269 elsif ($local_repo_unnecessary) {
270 # Don't bother to change directory in this case
271 scm (".", $scm, @scm_args, @_);
274 message "== Required repo $localpath is missing! Skipping";
277 message "== $localpath repo not present; skipping";
283 if (! -d ".git" || ! -d "compiler") {
284 die "error: sync-all must be run from the top level of the ghc tree."
292 # We handle -q here as well as lower down as we need to skip over it
293 # if it comes before the source-control command
297 elsif ($arg eq "-s") {
300 elsif ($arg eq "-r") {
301 $defaultrepo = shift;
303 elsif ($arg eq "--ignore-failure") {
306 elsif ($arg eq "--complete" || $arg eq "--partial") {
309 # Use --checked-out if the remote repos are a checked-out tree,
310 # rather than the master trees.
311 elsif ($arg eq "--checked-out") {
312 $checked_out_flag = 1;
314 # --<tag> says we grab the libs tagged 'tag' with
315 # 'get'. It has no effect on the other commands.
316 elsif ($arg =~ m/^--/) {
322 if (grep /^-q$/, @_) {
330 # Get the built in help
332 What do you want to do?
347 Available package-tags are:
350 # Collect all the tags in the packages file
352 open IN, "< packages" or die "Can't open packages file";
355 if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
356 if (defined($2) && $2 ne "-") {
357 $available_tags{$2} = 1;
360 elsif (! /^(#.*)?$/) {
366 # Show those tags and the help text
367 my @available_tags = keys %available_tags;
368 print "$help@available_tags\n";
372 # Give the command and rest of the arguments to the main loop