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.git" 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";
121 message "== running $scm @_";
122 system ($scm, @_) == 0
124 or die "$scm failed: $?";
128 my ($scm, $localpath) = @_;
130 if ($scm eq "darcs") {
131 -d "$localpath/_darcs";
134 -d "$localpath/.git";
149 my $wd_before = getcwd;
153 my ($repo_base, $checked_out_tree) = getrepo();
157 for $line (@packages) {
159 $localpath = $$line{"localpath"};
160 $tag = $$line{"tag"};
161 $remotepath = $$line{"remotepath"};
162 $scm = $$line{"vcs"};
163 $upstream = $$line{"upstream"};
165 # Check the SCM is OK as early as possible
166 die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
168 # Work out the path for this package in the repo we pulled from
169 if ($checked_out_tree) {
170 $path = "$repo_base/$localpath";
173 $path = "$repo_base/$remotepath";
176 # Work out the arguments we should give to the SCM
177 if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
178 @scm_args = (($scm eq "darcs" and "whatsnew")
179 or ($scm eq "git" and "status"));
181 # Hack around 'darcs whatsnew' failing if there are no changes
184 elsif ($command =~ /^(?:pus|push)$/) {
186 $want_remote_repo = 1;
188 elsif ($command =~ /^(?:pul|pull)$/) {
190 $want_remote_repo = 1;
191 # Q: should we append the -a argument for darcs repos?
193 elsif ($command =~ /^(?:g|ge|get)$/) {
194 # Skip any repositories we have not included the tag for
195 if (not defined($tags{$tag})) {
200 warning("$localpath already present; omitting") if $localpath ne ".";
204 # The first time round the loop, default the get-mode
205 if (not defined($get_mode)) {
206 warning("adding --partial, to override use --complete");
207 $get_mode = "--partial";
210 # The only command that doesn't need a repo
211 $local_repo_unnecessary = 1;
213 if ($scm eq "darcs") {
214 # Note: we can only use the get-mode with darcs for now
215 @scm_args = ("get", $get_mode, $path, $localpath);
218 @scm_args = ("clone", $path, $localpath);
221 elsif ($command =~ /^(?:s|se|sen|send)$/) {
222 @scm_args = (($scm eq "darcs" and "send")
223 or ($scm eq "git" and "send-email"));
224 $want_remote_repo = 1;
227 die "Unknown command: $command";
230 # Actually execute the command
231 if (repoexists ($scm, $localpath)) {
232 if ($want_remote_repo) {
233 if ($scm eq "darcs") {
234 scm ($scm, @scm_args, @_, "--repodir=$localpath", $path);
236 # git pull doesn't like to be used with --work-dir
237 scm ($scm, "--git-dir=$localpath/.git", @scm_args, @_, $path, "master");
240 # git status *must* be used with --work-dir, if we don't chdir() to the dir
241 scm ($scm, "--git-dir=$localpath/.git", "--work-tree=$localpath", @scm_args, @_);
244 elsif ($local_repo_unnecessary) {
245 # Don't bother to change directory in this case
246 scm ($scm, @scm_args, @_);
249 message "== Required repo $localpath is missing! Skipping";
252 message "== $localpath repo not present; skipping";
258 if (! -d ".git" || ! -d "compiler") {
259 die "error: sync-all must be run from the top level of the ghc tree."
267 # We handle -q here as well as lower down as we need to skip over it
268 # if it comes before the source-control command
272 elsif ($arg eq "-s") {
275 elsif ($arg eq "-r") {
276 $defaultrepo = shift;
278 elsif ($arg eq "--ignore-failure") {
281 elsif ($arg eq "--complete" || $arg eq "--partial") {
284 # Use --checked-out if the remote repos are a checked-out tree,
285 # rather than the master trees.
286 elsif ($arg eq "--checked-out") {
287 $checked_out_flag = 1;
289 # --<tag> says we grab the libs tagged 'tag' with
290 # 'get'. It has no effect on the other commands.
291 elsif ($arg =~ m/^--/) {
297 if (grep /^-q$/, @_) {
305 # Get the built in help
307 What do you want to do?
319 Available package-tags are:
322 # Collect all the tags in the packages file
324 open IN, "< packages" or die "Can't open packages file";
327 if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
328 if (defined($2) && $2 ne "-") {
329 $available_tags{$2} = 1;
332 elsif (! /^(#.*)?$/) {
338 # Show those tags and the help text
339 my @available_tags = keys %available_tags;
340 print "$help@available_tags\n";
344 # Give the command and rest of the arguments to the main loop