X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=push-all;fp=push-all;h=ef4dbc8d53150cceb5c6fb9aa0f2844c4cf01c94;hp=0000000000000000000000000000000000000000;hb=e0f750296ef29dc073f80d4e60e48c1db4a15a35;hpb=74df25b15c34c4554660b76d1ae09b721d0aa59b diff --git a/push-all b/push-all new file mode 100644 index 0000000..ef4dbc8 --- /dev/null +++ b/push-all @@ -0,0 +1,129 @@ +#!/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 = ; + 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); +