Fix Trac #2756: CorePrep strictness bug
[ghc-hetmet.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 @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