Ticket #3375: 0001-Replace-push-all-with-darcs-all-and-r-option.2.patch

File 0001-Replace-push-all-with-darcs-all-and-r-option.2.patch, 9.5 KB (added by seliopou, 6 years ago)

Updated patch (v3): Replace push-all with darcs-all

  • darcs-all

    From 92b5ea12435b4008aa49a2d07779a4d9774268bc Mon Sep 17 00:00:00 2001
    From: Spiridon Eliopoulos <[email protected]>
    Date: Wed, 15 Jul 2009 22:23:20 -0400
    Subject: [PATCH] Replace push-all with darcs-all and -r option
    
    Use the -r option to specify the repository darcs-all should use to when
    performing the specified command.
    ---
     darcs-all |  108 +++++++++++++++++++++++++++++++++++----------------
     push-all  |  129 -------------------------------------------------------------
     2 files changed, 75 insertions(+), 162 deletions(-)
     delete mode 100755 push-all
    
    diff --git a/darcs-all b/darcs-all
    index e8a1139..347fc83 100755
    a b use strict; 
    44
    55# Usage:
    66#
    7 # ./darcs-all [-q] [-s] [--nofib] [--testsuite] get [darcs get flags]
     7# ./darcs-all [-q] [-s] [-r repo] [--nofib] [--testsuite] get [darcs get flags]
    88#   This gets the GHC core repos, if they do not already exist.
    99#   -q says to be quite, and -s to be silent.
     10#   -r repo says to use repo as the location of package repositories
    1011#   --nofib, --testsuite also get the nofib and testsuite repos respectively
    1112#   The darcs get flag you are most likely to want is --complete. By
    1213#   default we pass darcs the --partial flag.
    1314#
    14 # ./darcs-all [-q] [-s] cmd [darcs cmd flags]
     15# ./darcs-all [-q] [-s] [-r repo] cmd [darcs cmd flags]
    1516#   This runs the darcs "cmd" command, with any flags you give, in all
    1617#   of the repos you have checked out. e.g.
    1718#       ./darcs-all pull
    use strict; 
    2021
    2122$| = 1; # autoflush stdout after each print, to avoid output after die
    2223
    23 # Figure out where to get the other repositories from,
    24 # based on where this GHC repo came from.
    25 my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
    26 chomp $defaultrepo;
    27 my $defaultrepo_base;
    28 my $checked_out_tree;
    29 
    30 if ($defaultrepo =~ /^...*:/) {
    31     # HTTP or SSH
    32     # Above regex says "at least two chars before the :", to avoid
    33     # catching Win32 drives ("C:\").
    34     $defaultrepo_base = $defaultrepo;
    35     $defaultrepo_base =~ s#/[^/]+/?$##;
    36     $checked_out_tree = 0;
    37 }
    38 elsif ($defaultrepo =~ /^\/|\.\.\/|.:(\/|\\)/) {
    39     # Local filesystem, either absolute or relative path
    40     # (assumes a checked-out tree):
    41     $defaultrepo_base = $defaultrepo;
    42     $checked_out_tree = 1;
    43 }
    44 else {
    45     die "Couldn't work out defaultrepo";
    46 }
     24my $defaultrepo;
    4725
    4826my $verbose = 2;
    4927my $ignore_failure = 0;
    5028
    5129my %tags;
    5230
     31# Figure out where to get the other repositories from.
     32sub getrepo {
     33    my $basedir = ".";
     34    my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
     35    chomp $repo;
     36
     37    my $repo_base;
     38    my $checked_out_tree;
     39
     40    if ($repo =~ /^...*:/) {
     41        # HTTP or SSH
     42        # Above regex says "at least two chars before the :", to avoid
     43        # catching Win32 drives ("C:\").
     44        $repo_base = $repo;
     45        $checked_out_tree = 0;
     46
     47        # Don't drop the last part of the path if specified with -r, as
     48        # it expects repos of the form:
     49        #
     50        #   http://darcs.haskell.org
     51        #
     52        # rather than
     53        #   
     54        #   http://darcs.haskell.org/ghc
     55        #
     56        if (!$defaultrepo) {
     57            $repo_base =~ s#/[^/]+/?$##;
     58        }
     59    }
     60    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
     61        # Local filesystem, either absolute or relative path
     62        # (assumes a checked-out tree):
     63        $repo_base = $repo;
     64        $checked_out_tree = 1;
     65    }
     66    else {
     67        die "Couldn't work out repo";
     68    }
     69
     70    return $repo_base, $checked_out_tree;
     71}
     72
    5373sub message {
    5474    if ($verbose >= 2) {
    5575        print "@_\n";
    sub warning { 
    6585sub darcs {
    6686    message "== running darcs @_";
    6787    system ("darcs", @_) == 0
    68         or $ignore_failure
    69         or die "darcs failed: $?";
     88       or $ignore_failure
     89       or die "darcs failed: $?";
    7090}
    7191
    7292sub darcsall {
    7393    my $localpath;
     94    my $remotepath;
    7495    my $path;
    7596    my $tag;
    7697    my @repos;
    7798
     99    my ($repo_base, $checked_out_tree) = getrepo();
     100
    78101    open IN, "< packages" or die "Can't open packages file";
    79102    @repos = <IN>;
    80103    close IN;
    81104
    82     foreach (@repos) {
     105    REPO: foreach (@repos) {
    83106        chomp;
    84107        if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
    85108            $localpath = $1;
    86109            $tag = defined($2) ? $2 : "";
     110            $remotepath = $3;
     111
     112            if ($checked_out_tree) {
     113                $path = "$repo_base/$localpath";
     114            }
     115            else {
     116                if ($remotepath =~ /^http:/) {
     117                    message "Ignoring $localpath; remote is http URL";
     118                    next REPO;
     119                }
     120                else {
     121                    $path = "$repo_base/$remotepath";
     122                }
     123            }
    87124
    88125            if (-d "$localpath/_darcs") {
    89                 darcs (@_, "--repodir", $localpath);
     126                darcs (@_, "--repodir", $localpath, $path);
    90127            }
    91128            elsif ($tag eq "") {
    92129                message "== Required repo $localpath is missing! Skipping";
    sub darcsget { 
    109146    my $tag;
    110147    my @repos;
    111148
     149    my ($repo_base, $checked_out_tree) = getrepo();
     150
    112151    if (! grep /(?:--complete|--partial)/, @_) {
    113152        warning("adding --partial, to override use --complete");
    114153        $r_flags = [@_, "--partial"];
    sub darcsget { 
    129168            $remotepath = $3;
    130169
    131170            if ($checked_out_tree) {
    132                 $path = "$defaultrepo_base/$localpath";
     171                $path = "$repo_base/$localpath";
    133172            }
    134173            else {
    135174                if ($remotepath =~ /^http:/) {
    136175                    $path = $remotepath;
    137176                }
    138177                else {
    139                     $path = "$defaultrepo_base/$remotepath";
     178                    $path = "$repo_base/$remotepath";
    140179                }
    141180            }
    142181
    sub darcsget { 
    156195}
    157196
    158197sub main {
    159     if (! -d "_darcs" || ! -d "compiler") {
     198    if (! -d "compiler") {
    160199        die "error: darcs-all must be run from the top level of the ghc tree."
    161200    }
    162201
    sub main { 
    170209        elsif ($arg eq "-s") {
    171210            $verbose = 0;
    172211        }
     212        elsif ($arg eq "-r") {
     213            $defaultrepo = shift;
     214        }
    173215        # --nofib tells get to also grab the nofib repo.
    174216        # It has no effect on the other commands.
    175217        elsif ($arg eq "--nofib") {
  • deleted file push-all

    diff --git a/push-all b/push-all
    deleted file mode 100755
    index ef4dbc8..0000000
    + -  
    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