darcs-all 4.61 KB
Newer Older
Ian Lynagh's avatar
Ian Lynagh committed
1
#!/usr/bin/perl -w
2

Ian Lynagh's avatar
Ian Lynagh committed
3
use strict;
4

5 6
# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
Ian Lynagh's avatar
Ian Lynagh committed
7 8 9
my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
chomp $defaultrepo;
my $defaultrepo_base;
Ian Lynagh's avatar
Ian Lynagh committed
10
my $checked_out_tree;
Ian Lynagh's avatar
Ian Lynagh committed
11

Simon Marlow's avatar
Simon Marlow committed
12
if ($defaultrepo =~ /^...*:/) {
Ian Lynagh's avatar
Ian Lynagh committed
13
    # HTTP or SSH
Simon Marlow's avatar
Simon Marlow committed
14 15
    # Above regex says "at least two chars before the :", to avoid
    # catching Win32 drives ("C:\").
Ian Lynagh's avatar
Ian Lynagh committed
16
    $defaultrepo_base = $defaultrepo;
17
    $defaultrepo_base =~ s#/[^/]+/?$##;
Ian Lynagh's avatar
Ian Lynagh committed
18
    $checked_out_tree = 0;
19
}
20
elsif ($defaultrepo =~ /^\/|\.\.\/|.:(\/|\\)/) {
21 22
    # Local filesystem, either absolute or relative path
    # (assumes a checked-out tree):
Ian Lynagh's avatar
Ian Lynagh committed
23
    $defaultrepo_base = $defaultrepo;
Ian Lynagh's avatar
Ian Lynagh committed
24
    $checked_out_tree = 1;
25
}
Ian Lynagh's avatar
Ian Lynagh committed
26 27
else {
    die "Couldn't work out defaultrepo";
28 29
}

Ian Lynagh's avatar
Ian Lynagh committed
30
my $verbose = 2;
Ian Lynagh's avatar
Ian Lynagh committed
31
my $ignore_failure = 0;
32

Ian Lynagh's avatar
Ian Lynagh committed
33
my %tags;
Ian Lynagh's avatar
Ian Lynagh committed
34 35

sub message {
Ian Lynagh's avatar
Ian Lynagh committed
36
    if ($verbose >= 2) {
Ian Lynagh's avatar
Ian Lynagh committed
37 38 39 40 41
        print "@_\n";
    }
}

sub warning {
Ian Lynagh's avatar
Ian Lynagh committed
42 43 44
    if ($verbose >= 1) {
        print "warning: @_\n";
    }
Ian Lynagh's avatar
Ian Lynagh committed
45 46 47 48 49 50 51 52 53 54
}

sub darcs {
    message "== running darcs @_";
    system ("darcs", @_) == 0
        or $ignore_failure
        or die "darcs failed: $?";
}

sub darcsall {
Ian Lynagh's avatar
Ian Lynagh committed
55 56 57 58 59 60 61
    my $localpath;
    my $path;
    my $tag;

    open IN, "< packages" or die "Can't open packages file";
    while (<IN>) {
        chomp;
62
        if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
Ian Lynagh's avatar
Ian Lynagh committed
63 64
            $localpath = $1;
            $tag = defined($2) ? $2 : "";
Ian Lynagh's avatar
Ian Lynagh committed
65

Ian Lynagh's avatar
Ian Lynagh committed
66 67 68 69 70 71 72 73 74
            if (-d "$localpath/_darcs") {
                darcs (@_, "--repodir", $localpath);
            }
            elsif ($tag eq "") {
                message "== Required repo $localpath is missing! Skipping";
            }
            else {
                message "== $localpath repo not present; skipping";
            }
Ian Lynagh's avatar
Ian Lynagh committed
75
        }
76
        elsif (! /^(#.*)?$/) {
Ian Lynagh's avatar
Ian Lynagh committed
77
            die "Bad line: $_";
Ian Lynagh's avatar
Ian Lynagh committed
78 79
        }
    }
Ian Lynagh's avatar
Ian Lynagh committed
80
    close IN;
Ian Lynagh's avatar
Ian Lynagh committed
81 82 83 84
}

sub darcsget {
    my $r_flags;
Ian Lynagh's avatar
Ian Lynagh committed
85 86 87 88 89
    my $localpath;
    my $remotepath;
    my $path;
    my $tag;

90
    if (! grep /(?:--complete|--partial)/, @_) {
Ian Lynagh's avatar
Ian Lynagh committed
91 92 93 94 95 96 97
        warning("adding --partial, to override use --complete");
        $r_flags = [@_, "--partial"];
    }
    else {
        $r_flags = \@_;
    }

Ian Lynagh's avatar
Ian Lynagh committed
98 99 100 101 102 103 104
    open IN, "< packages" or die "Can't open packages file";
    while (<IN>) {
        chomp;
        if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+)/) {
            $localpath = $1;
            $tag = defined($2) ? $2 : "";
            $remotepath = $3;
Ian Lynagh's avatar
Ian Lynagh committed
105

Ian Lynagh's avatar
Ian Lynagh committed
106 107 108 109 110 111
            if ($checked_out_tree) {
                $path = "$defaultrepo_base/$localpath";
            }
            else {
                $path = "$defaultrepo_base/$remotepath";
            }
Ian Lynagh's avatar
Ian Lynagh committed
112

Ian Lynagh's avatar
Ian Lynagh committed
113 114 115 116 117 118 119 120 121 122 123 124
            if (($tag eq "") || defined($tags{$tag})) {
                if (-d $localpath) {
                    warning("$localpath already present; omitting");
                }
                else {
                    darcs (@$r_flags, $path, $localpath);
                }
            }
        }
        elsif (! /^$/) {
            die "Bad line: $_";
        }
Ian Lynagh's avatar
Ian Lynagh committed
125
    }
Ian Lynagh's avatar
Ian Lynagh committed
126
    close IN;
Ian Lynagh's avatar
Ian Lynagh committed
127 128 129 130 131 132 133
}

sub main {
    if (! -d "_darcs" || ! -d "compiler") {
        die "error: darcs-all must be run from the top level of the ghc tree."
    }

134 135
    while ($#_ ne -1) {
        my $arg = shift;
136 137
        # We handle -q here as well as lower down as we need to skip over it
        # if it comes before the darcs command
138
        if ($arg eq "-q") {
Ian Lynagh's avatar
Ian Lynagh committed
139 140 141
            $verbose = 1;
        }
        elsif ($arg eq "-s") {
142 143
            $verbose = 0;
        }
144 145 146 147 148
        # --dph says we grab the dph libs with 'get'.
        # It has no effect on the other commands.
        elsif ($arg eq "--dph") {
            $tags{"dph"} = 1;
        }
Ian Lynagh's avatar
Ian Lynagh committed
149 150
        # --extra says we grab the extra libs with 'get'.
        # It has no effect on the other commands.
151
        elsif ($arg eq "--extra") {
Ian Lynagh's avatar
Ian Lynagh committed
152
            $tags{"extralibs"} = 1;
153
        }
Ian Lynagh's avatar
Ian Lynagh committed
154 155
        # --nofib tells get to also grab the nofib repo.
        # It has no effect on the other commands.
156
        elsif ($arg eq "--nofib") {
Ian Lynagh's avatar
Ian Lynagh committed
157
            $tags{"nofib"} = 1;
158
        }
Ian Lynagh's avatar
Ian Lynagh committed
159 160
        # --testsuite tells get to also grab the testsuite repo.
        # It has no effect on the other commands.
161
        elsif ($arg eq "--testsuite") {
Ian Lynagh's avatar
Ian Lynagh committed
162
            $tags{"testsuite"} = 1;
163 164 165
        }
        else {
            unshift @_, $arg;
166
            if (grep /^-q$/, @_) {
Ian Lynagh's avatar
Ian Lynagh committed
167
                $verbose = 1;
168
            }
169 170 171 172
            last;
        }
    }

Ian Lynagh's avatar
Ian Lynagh committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
    if ($#_ eq -1) {
        die "What do you want to do?";
    }
    my $command = $_[0];
    if ($command eq "get") {
        darcsget @_;
    }
    else {
        if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
            # Hack around whatsnew failing if there are no changes
            $ignore_failure = 1;
        }
        darcsall @_;
    }
}

main(@ARGV);