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