diff options
| -rw-r--r-- | darcs-all | 112 | ||||
| -rw-r--r-- | push-all | 129 |
2 files changed, 79 insertions, 162 deletions
@@ -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") { diff --git a/push-all b/push-all deleted file mode 100644 index ef4dbc8d53..0000000000 --- a/push-all +++ /dev/null @@ -1,129 +0,0 @@ -#!/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); - |