1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
#!/usr/bin/env perl
# Script to remove repositories in ~/src, including removing their
# entries from ~/.mrconfig. Confirmation is required only if the
# repository has uncommitted changes, untracked files or unpushed
# branches
# For convenient tab-completion of the repository names, run this
# script from ~/src
use strict;
use warnings;
use lib "$ENV{HOME}/src/dotfiles/perl5";
use Cwd;
use File::Basename;
use File::Spec::Functions;
use Local::Util::Git qw(unpushed_tags);
die "need at least one argument" if ( @ARGV < 1 );
my $force = 0;
my @to_remove;
foreach my $arg (@ARGV) {
if ($arg =~ /\A-f\z/) {
$force = 1;
} elsif (-d $arg) {
push @to_remove, $arg;
} else {
die "$arg could not be a repo\n";
}
}
# we will need to call `mr status` on the repo, so ensure it is registered
system "src-register-all";
die "src-register-all failed\n" unless ($? == 0);
my @known_repos;
for my $f ("$ENV{HOME}/.mrconfig",
"$ENV{HOME}/src/dotfiles/lib-src/mr/config") {
open my $fh, "<", $f;
while (<$fh>) {
if (/^\[(src\/.+)\]$/) {
push @known_repos, catfile($ENV{HOME}, $1);
}
}
}
foreach my $repo (@to_remove) {
my $block = File::Spec->rel2abs($repo);
die "$repo is not known to mr" unless grep /\A$block\z/, @known_repos;
my $output = `mr -m -d $repo status 2>&1`;
print STDERR "$output" if length $output > 0;
my $pwd = getcwd;
chdir $repo;
my @unpushed_tags;
if (@unpushed_tags = unpushed_tags) {
print "E: the following tags have not been pushed to any remote:\n";
print join ", ", @unpushed_tags;
print "\n";
}
chdir $pwd;
die "repo $repo might contain work; pass -f to delete anyway\n"
if !$force && (length $output > 0 || @unpushed_tags);
$block =~ s/^$ENV{HOME}\///;
remove_block_from_ini(catfile($ENV{HOME}, ".mrconfig"), $block);
system "rm -rf $repo/../".basename($repo)."_*.orig.tar.* $repo";
}
sub remove_block_from_ini {
my ($ini, $block) = @_;
my @lines;
my $fh;
open $fh, '<', $ini;
my $copy = 1;
while (<$fh>) {
chomp;
if (/^\[$block\]$/) {
$copy = 0;
} elsif (/^\[.+\]$/) {
$copy = 1;
push @lines, $_;
} elsif ($copy) {
push @lines, $_;
}
}
close $fh;
open $fh, '>', $ini;
print $fh "$_\n" for @lines;
}
|
