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 $ghcrepo = $checked_out ? $reporoot : "$reporoot/ghc";
  43     darcs_push ($ghcrepo, @_);
  44
  45     open IN, "< packages" or die "Can't open packages file";
  46     while (<IN>) {
  47         chomp;
  48         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+)/) {
  49             $localpath = $1;
  50             $tag = defined($2) ? $2 : "";
  51             $remotepath = $3;
  52
  53             if ($checked_out) {
  54                 $path = "$reporoot/$localpath";
  55             }
  56             else {
  57                 $path = "$reporoot/$remotepath";
  58             }
  59
  60             if (-d "$localpath/_darcs") {
  61                 darcs_push ($path, @_, "--repodir", $localpath);
  62             }
  63             elsif ($tag eq "") {
  64                 message "== Required repo $localpath is missing! Skipping";
  65             }
  66             else {
  67                 message "== $localpath repo not present; skipping";
  68             }
  69         }
  70         elsif (! /^(#.*)?$/) {
  71             die "Bad line: $_";
  72         }
  73     }
  74     close IN;
  75 }
  76
  77 sub main {
  78     if (! -d "_darcs" || ! -d "compiler") {
  79         die "error: darcs-all must be run from the top level of the ghc tree."
  80     }
  81
  82     if ($#_ ne -1) {
  83         while ($#_ ne -1) {
  84             my $arg = shift;
  85             # We handle -q here as well as lower down as we need to skip
  86             # over it if it comes before the darcs command
  87             if ($arg eq "-q") {
  88                 $verbose = 0;
  89             }
  90             elsif ($arg eq "--ignore-failure") {
  91                 $ignore_failure = 1;
  92             }
  93             elsif ($arg eq "--checked-out") {
  94                 $checked_out = 1;
  95             }
  96             elsif ($arg eq "--push") {
  97                 $push_pull_send = "push";
  98             }
  99             elsif ($arg eq "--pull") {
 100                 $push_pull_send = "pull";
 101             }
 102             elsif ($arg eq "--send") {
 103                 $push_pull_send = "send";
 104             }
 105             else {
 106                 $reporoot = $arg;
 107                 if (grep /^-q$/, @_) {
 108                     $verbose = 0;
 109                 }
 110                 last;
 111             }
 112         }
 113     }
 114     else {
 115         die "Where do you want to push to?";
 116     }
 117
 118     pushall (@_);
 119 }
 120
 121 main(@ARGV);
 122