545cbe216a7bc120653205fbcf82c46b0db53d57
[ghc.git] / 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