use strict;
use Cwd;
+# Usage:
+#
+# ./sync-all [-q] [-s] [--ignore-failure] [-r repo]
+# [--nofib] [--testsuite] [--checked-out] cmd [git flags]
+#
+# Applies the command "cmd" to each repository in the tree.
+# sync-all will try to do the right thing for both git and darcs repositories.
+#
+# e.g.
+# ./sync-all -r http://darcs.haskell.org/ghc get
+# To get any repos which do not exist in the local tree
+#
+# ./sync-all pull
+# To pull everything from the default repos
+#
+# -------------- Flags -------------------
+# -q says to be quite, and -s to be silent.
+#
+# --ignore-failure says to ignore errors and move on to the next repository
+#
+# -r repo says to use repo as the location of package repositories
+#
+# --checked-out says that the remote repo is in checked-out layout, as
+# opposed to the layout used for the main repo. By default a repo on
+# the local filesystem is assumed to be checked-out, and repos accessed
+# via HTTP or SSH are assumed to be in the main repo layout; use
+# --checked-out to override the latter.
+#
+# --nofib, --testsuite also get the nofib and testsuite repos respectively
+#
+# ------------ Which repos to use -------------
+# sync-all uses the following algorithm to decide which remote repos to use
+#
+# It always computes the remote repos from a single base, $repo_base
+# How is $repo_base set?
+# If you say "-r repo", then that's $repo_base
+# otherwise $repo_base is set by asking git where the ghc repo came
+# from, and removing the last component (e.g. /ghc.git/ of /ghc/).
+#
+# Then sync-all iterates over the package found in the file
+# ./packages; see that file for a description of the contents.
+#
+# If $repo_base looks like a local filesystem path, or if you give
+# the --checked-out flag, sync-all works on repos of form
+# $repo_base/<local-path>
+# otherwise sync-all works on repos of form
+# $repo_base/<remote-path>
+# This logic lets you say
+# both sync-all -r http://darcs.haskell.org/ghc-6.12 pull
+# and sync-all -r ../HEAD pull
+# The latter is called a "checked-out tree".
+
+# NB: sync-all *ignores* the defaultrepo of all repos other than the
+# root one. So the remote repos must be laid out in one of the two
+# formats given by <local-path> and <remote-path> in the file 'packages'.
+
+$| = 1; # autoflush stdout after each print, to avoid output after die
+
my $defaultrepo;
my @packages;
my $verbose = 2;
my $scm;
my $upstream;
my $line;
+ my $branch_name;
+ my $subcommand;
my $path;
my $wd_before = getcwd;
parsePackages;
+ if ($command =~ /^remote$/) {
+ if (@_ < 2) {
+ help();
+ }
+ $subcommand = shift;
+ $branch_name = shift;
+ if ($subcommand ne 'add' && $subcommand ne 'rm') {
+ help();
+ }
+ } elsif ($command eq 'new' || $command eq 'fetch') {
+ if (@_ < 1) {
+ $branch_name = 'origin';
+ } else {
+ $branch_name = shift;
+ }
+ }
+
for $line (@packages) {
$localpath = $$line{"localpath"};
}
# The first time round the loop, default the get-mode
- if (not defined($get_mode)) {
+ if ($scm eq "darcs" && not defined($get_mode)) {
warning("adding --partial, to override use --complete");
$get_mode = "--partial";
}
elsif ($command =~ /^set-origin$/) {
@scm_args = ("remote", "set-url", "origin", $path);
}
+ elsif ($command =~ /^set-push$/) {
+ @scm_args = ("remote", "set-url", "--push", "origin", $path);
+ }
+ elsif ($command =~ /^fetch$/) {
+ @scm_args = ("fetch", "$branch_name");
+ }
+ elsif ($command =~ /^new$/) {
+ @scm_args = ("log", "$branch_name..");
+ }
+ elsif ($command =~ /^remote$/) {
+ if ($subcommand eq 'add') {
+ @scm_args = ("remote", "add", $branch_name, $path);
+ } elsif ($subcommand eq 'rm') {
+ @scm_args = ("remote", "rm", $branch_name);
+ }
+ }
else {
die "Unknown command: $command";
}
}
}
+
+sub help()
+{
+ # Get the built in help
+ my $help = <<END;
+What do you want to do?
+Supported commands:
+
+ * whatsnew
+ * push
+ * pull
+ * get, with options:
+ * --<package-tag>
+ * --complete
+ * --partial
+ * fetch
+ * send
+ * set-origin
+ * set-push
+ * new
+ * remote add <branch-name>
+ * remote rm <branch-name>
+
+Available package-tags are:
+END
+
+ # Collect all the tags in the packages file
+ my %available_tags;
+ open IN, "< packages" or die "Can't open packages file";
+ while (<IN>) {
+ chomp;
+ if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
+ if (defined($2) && $2 ne "-") {
+ $available_tags{$2} = 1;
+ }
+ }
+ elsif (! /^(#.*)?$/) {
+ die "Bad line: $_";
+ }
+ }
+ close IN;
+
+ # Show those tags and the help text
+ my @available_tags = keys %available_tags;
+ print "$help@available_tags\n";
+ exit 1;
+}
+
sub main {
if (! -d ".git" || ! -d "compiler") {
die "error: sync-all must be run from the top level of the ghc tree."
}
if ($#_ eq -1) {
- # Get the built in help
- my $help = <<END;
-What do you want to do?
-Supported commands:
-
- * whatsnew
- * push
- * pull
- * get, with options:
- * --<package-tag>
- * --complete
- * --partial
- * send
- * set-origin
-
-Available package-tags are:
-END
-
- # Collect all the tags in the packages file
- my %available_tags;
- open IN, "< packages" or die "Can't open packages file";
- while (<IN>) {
- chomp;
- if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
- if (defined($2) && $2 ne "-") {
- $available_tags{$2} = 1;
- }
- }
- elsif (! /^(#.*)?$/) {
- die "Bad line: $_";
- }
- }
- close IN;
-
- # Show those tags and the help text
- my @available_tags = keys %available_tags;
- print "$help@available_tags\n";
- exit 1;
+ help();
}
else {
# Give the command and rest of the arguments to the main loop
projects / ghc-hetmet.git / blobdiff