Commit fee305ed authored by Simon Marlow's avatar Simon Marlow

Add -r option to darcs-all, and remove push-all (#3375)

Contributed by: seliopou@gmail.com
    
This patch modifies darcs-all to have feature parity with push-all by
recognizing two new options.

    * -i, equivalent to --ignore-failure in push-all
    * -r <repo>, specifies the remote repository darcs commands will use

Some example commands:

Get the libraries from a repository of your choosing. This is useful
when working with a git mirror:

    $ ./darcs-all -r http://darcs.haskell.org get

Pull changes. Used to be:

    $ ./push-all --pull http://darcs.haskell.org

Is now:

    $ ./darcs-all -r http://darcs.haskell.org pull

Or to use the default remote of the ghc repository:

    $ ./darcs-all pull
parent a634a40c
......@@ -4,14 +4,16 @@ use strict;
# Usage:
#
# ./darcs-all [-q] [-s] [--nofib] [--testsuite] get [darcs get flags]
# ./darcs-all [-q] [-s] [-i] [-r repo] [--nofib] [--testsuite] get [darcs get flags]
# This gets the GHC core repos, if they do not already exist.
# -q says to be quite, and -s to be silent.
# -i says to ignore darcs errors and move on to the next repository
# -r repo says to use repo as the location of package repositories
# --nofib, --testsuite also get the nofib and testsuite repos respectively
# The darcs get flag you are most likely to want is --complete. By
# default we pass darcs the --partial flag.
#
# ./darcs-all [-q] [-s] cmd [darcs cmd flags]
# ./darcs-all [-q] [-s] [-i] [-r repo] cmd [darcs cmd flags]
# This runs the darcs "cmd" command, with any flags you give, in all
# of the repos you have checked out. e.g.
# ./darcs-all pull
......@@ -20,36 +22,55 @@ use strict;
$| = 1; # autoflush stdout after each print, to avoid output after die
# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
chomp $defaultrepo;
my $defaultrepo_base;
my $checked_out_tree;
if ($defaultrepo =~ /^...*:/) {
# HTTP or SSH
# Above regex says "at least two chars before the :", to avoid
# catching Win32 drives ("C:\").
$defaultrepo_base = $defaultrepo;
$defaultrepo_base =~ s#/[^/]+/?$##;
$checked_out_tree = 0;
}
elsif ($defaultrepo =~ /^\/|\.\.\/|.:(\/|\\)/) {
# Local filesystem, either absolute or relative path
# (assumes a checked-out tree):
$defaultrepo_base = $defaultrepo;
$checked_out_tree = 1;
}
else {
die "Couldn't work out defaultrepo";
}
my $defaultrepo;
my $verbose = 2;
my $ignore_failure = 0;
my %tags;
# Figure out where to get the other repositories from.
sub getrepo {
my $basedir = ".";
my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
chomp $repo;
my $repo_base;
my $checked_out_tree;
if ($repo =~ /^...*:/) {
# HTTP or SSH
# Above regex says "at least two chars before the :", to avoid
# catching Win32 drives ("C:\").
$repo_base = $repo;
$checked_out_tree = 0;
# Don't drop the last part of the path if specified with -r, as
# it expects repos of the form:
#
# http://darcs.haskell.org
#
# rather than
#
# http://darcs.haskell.org/ghc
#
if (!$defaultrepo) {
$repo_base =~ s#/[^/]+/?$##;
}
}
elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
# Local filesystem, either absolute or relative path
# (assumes a checked-out tree):
$repo_base = $repo;
$checked_out_tree = 1;
}
else {
die "Couldn't work out repo";
}
return $repo_base, $checked_out_tree;
}
sub message {
if ($verbose >= 2) {
print "@_\n";
......@@ -65,28 +86,45 @@ sub warning {
sub darcs {
message "== running darcs @_";
system ("darcs", @_) == 0
or $ignore_failure
or die "darcs failed: $?";
or $ignore_failure
or die "darcs failed: $?";
}
sub darcsall {
my $localpath;
my $remotepath;
my $path;
my $tag;
my @repos;
my ($repo_base, $checked_out_tree) = getrepo();
open IN, "< packages" or die "Can't open packages file";
@repos = <IN>;
close IN;
foreach (@repos) {
REPO: foreach (@repos) {
chomp;
if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
$localpath = $1;
$tag = defined($2) ? $2 : "";
$remotepath = $3;
if ($checked_out_tree) {
$path = "$repo_base/$localpath";
}
else {
if ($remotepath =~ /^http:/) {
message "Ignoring $localpath; remote is http URL";
next REPO;
}
else {
$path = "$repo_base/$remotepath";
}
}
if (-d "$localpath/_darcs") {
darcs (@_, "--repodir", $localpath);
darcs (@_, "--repodir", $localpath, $path);
}
elsif ($tag eq "") {
message "== Required repo $localpath is missing! Skipping";
......@@ -109,6 +147,8 @@ sub darcsget {
my $tag;
my @repos;
my ($repo_base, $checked_out_tree) = getrepo();
if (! grep /(?:--complete|--partial)/, @_) {
warning("adding --partial, to override use --complete");
$r_flags = [@_, "--partial"];
......@@ -129,14 +169,14 @@ sub darcsget {
$remotepath = $3;
if ($checked_out_tree) {
$path = "$defaultrepo_base/$localpath";
$path = "$repo_base/$localpath";
}
else {
if ($remotepath =~ /^http:/) {
$path = $remotepath;
}
else {
$path = "$defaultrepo_base/$remotepath";
$path = "$repo_base/$remotepath";
}
}
......@@ -156,7 +196,7 @@ sub darcsget {
}
sub main {
if (! -d "_darcs" || ! -d "compiler") {
if (! -d "compiler") {
die "error: darcs-all must be run from the top level of the ghc tree."
}
......@@ -170,6 +210,12 @@ sub main {
elsif ($arg eq "-s") {
$verbose = 0;
}
elsif ($arg eq "-r") {
$defaultrepo = shift;
}
elsif ($arg eq "-i") {
$ignore_failure = 1;
}
# --nofib tells get to also grab the nofib repo.
# It has no effect on the other commands.
elsif ($arg eq "--nofib") {
......
#!/usr/bin/perl -w
use strict;
my $reporoot;
my $verbose = 1;
my $ignore_failure = 0;
# --checked-out says we are pushing to a checked out tree
my $checked_out = 0;
# --push or --pull or --send?
my $push_pull_send = "push";
sub message {
if ($verbose) {
print "@_\n";
}
}
sub warning {
print "warning: @_\n";
}
sub darcs {
message "== running darcs @_";
system ("darcs", @_) == 0
or $ignore_failure
or die "darcs failed: $?";
}
sub darcs_push {
darcs ($push_pull_send, "--no-set-default", @_);
}
sub pushall {
my $dir;
my $localpath;
my $remotepath;
my $path;
my $tag;
my @repos;
open IN, "< packages" or die "Can't open packages file";
@repos = <IN>;
close IN;
REPO: foreach (@repos) {
chomp;
if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
$localpath = $1;
$tag = defined($2) ? $2 : "";
$remotepath = $3;
if ($checked_out) {
$path = "$reporoot/$localpath";
}
else {
if ($remotepath =~ /^http:/) {
message "Ignoring $localpath; remote is http URL";
next REPO;
}
else {
$path = "$reporoot/$remotepath";
}
}
if (-d "$localpath/_darcs") {
darcs_push ($path, @_, "--repodir", $localpath);
}
elsif ($tag eq "") {
message "== Required repo $localpath is missing! Skipping";
}
else {
message "== $localpath repo not present; skipping";
}
}
elsif (! /^(#.*)?$/) {
die "Bad line: $_";
}
}
}
sub main {
if (! -d "_darcs" || ! -d "compiler") {
die "error: darcs-all must be run from the top level of the ghc tree."
}
if ($#_ ne -1) {
while ($#_ ne -1) {
my $arg = shift;
# We handle -q here as well as lower down as we need to skip
# over it if it comes before the darcs command
if ($arg eq "-q") {
$verbose = 0;
}
elsif ($arg eq "--ignore-failure") {
$ignore_failure = 1;
}
elsif ($arg eq "--checked-out") {
$checked_out = 1;
}
elsif ($arg eq "--push") {
$push_pull_send = "push";
}
elsif ($arg eq "--pull") {
$push_pull_send = "pull";
}
elsif ($arg eq "--send") {
$push_pull_send = "send";
}
else {
$reporoot = $arg;
if (grep /^-q$/, @_) {
$verbose = 0;
}
last;
}
}
}
else {
die "Where do you want to push to?";
}
pushall (@_);
}
main(@ARGV);
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment