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