push-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my $reporoot;
   6
   7 my $verbose = 1;
   8 my $ignore_failure = 0;
   9
  10 # --checked-out says we are pushing to a checked out tree
  11 my $checked_out = 0;
  12 # --push or --pull or --send?
  13 my $push_pull_send = "push";
  14
  15 sub message {
  16     if ($verbose) {
  17         print "@_\n";
  18     }
  19 }
  20
  21 sub warning {
  22     print "warning: @_\n";
  23 }
  24
  25 sub darcs {
  26     message "== running darcs @_";
  27     system ("darcs", @_) == 0
  28         or $ignore_failure
  29         or die "darcs failed: $?";
  30 }
  31
  32 sub darcs_push {
  33     darcs ($push_pull_send, "--no-set-default", @_);
  34 }
  35
  36 sub pushall {
  37     my $dir;
  38     my $localpath;
  39     my $remotepath;
  40     my $path;
  41     my $tag;
  42     my @repos;
  43
  44     open IN, "< packages" or die "Can't open packages file";
  45     @repos = <IN>;
  46     close IN;
  47
  48     REPO: foreach (@repos) {
  49         chomp;
  50         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
  51             $localpath = $1;
  52             $tag = defined($2) ? $2 : "";
  53             $remotepath = $3;
  54
  55             if ($checked_out) {
  56                 $path = "$reporoot/$localpath";
  57             }
  58             else {
  59                 if ($remotepath =~ /^http:/) {
  60                     message "Ignoring $localpath; remote is http URL";
  61                     next REPO;
  62                 }
  63                 else {
  64                     $path = "$reporoot/$remotepath";
  65                 }
  66             }
  67
  68             if (-d "$localpath/_darcs") {
  69                 darcs_push ($path, @_, "--repodir", $localpath);
  70             }
  71             elsif ($tag eq "") {
  72                 message "== Required repo $localpath is missing! Skipping";
  73             }
  74             else {
  75                 message "== $localpath repo not present; skipping";
  76             }
  77         }
  78         elsif (! /^(#.*)?$/) {
  79             die "Bad line: $_";
  80         }
  81     }
  82 }
  83
  84 sub main {
  85     if (! -d "_darcs" || ! -d "compiler") {
  86         die "error: darcs-all must be run from the top level of the ghc tree."
  87     }
  88
  89     if ($#_ ne -1) {
  90         while ($#_ ne -1) {
  91             my $arg = shift;
  92             # We handle -q here as well as lower down as we need to skip
  93             # over it if it comes before the darcs command
  94             if ($arg eq "-q") {
  95                 $verbose = 0;
  96             }
  97             elsif ($arg eq "--ignore-failure") {
  98                 $ignore_failure = 1;
  99             }
 100             elsif ($arg eq "--checked-out") {
 101                 $checked_out = 1;
 102             }
 103             elsif ($arg eq "--push") {
 104                 $push_pull_send = "push";
 105             }
 106             elsif ($arg eq "--pull") {
 107                 $push_pull_send = "pull";
 108             }
 109             elsif ($arg eq "--send") {
 110                 $push_pull_send = "send";
 111             }
 112             else {
 113                 $reporoot = $arg;
 114                 if (grep /^-q$/, @_) {
 115                     $verbose = 0;
 116                 }
 117                 last;
 118             }
 119         }
 120     }
 121     else {
 122         die "Where do you want to push to?";
 123     }
 124
 125     pushall (@_);
 126 }
 127
 128 main(@ARGV);
 129