rewrite bin/src-*

2 files changed, 117 insertions, 62 deletions

diff --git a/bin/src-register-all b/bin/src-register-all
index 5d5bae59..541f196d 100755
--- a/bin/src-register-all
+++ b/bin/src-register-all
@@ -1,21 +1,68 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
 
-# Add new all new git/hg repos in ~/src to ~/src/.mrconfig
+# src-register-all -- add new all new git/hg repos in ~/src to ~/.mrconfig
+
+# Copyright (C) 2019 Sean Whitton
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+
+# This script must be as portable as possible (inc. its shebang).
 
 use strict;
 use warnings;
-use File::Basename;
-use File::Grep "fgrep";
-use File::chdir;
-
-# TODO should recurse into arbitarary subdirectories of ~/src
-
-foreach my $f ( glob "$ENV{'HOME'}/src/*" ) {
-    my $short = basename($f);
-    next unless ( -d "$f/.git" || -d "$f/.hg" );
-    {
-        local $CWD = $f;
-        system "mr register >/dev/null";
-        die "failed to register ~/src/$short" unless ($? >> 8 == 0);
+
+use Cwd;
+use File::Find;
+
+chdir;
+my @known_repos;
+open my $fh, "<", ".mrconfig";
+while (<$fh>) {
+    if (/^\[(src\/.+)\]$/) {
+        push @known_repos, getcwd()."/$1";
     }
 }
+find({wanted => \&register, preprocess => \&skip}, "src");
+
+sub skip {
+    my $cwd = getcwd();
+    # once we've found a repo, don't search inside it for more repos
+    return () if is_repo($cwd);
+    my @entries;
+    # don't process repos mr already knows about
+    foreach my $entry (@_) {
+        my $entry_path = $cwd."/$entry";
+        push @entries, $entry
+          unless grep /\A$entry_path\z/, @known_repos;;
+    }
+    return @entries;
+}
+sub register {
+    return unless is_repo($_);
+    chdir $_;
+    my $register_out = `mr -c $ENV{HOME}/.mrconfig register 2>&1`;
+    unless ($? == 0) {
+        print "mr register: $File::Find::name\n";
+        print $register_out;
+        die "\n";
+    }
+    chdir "..";
+}
+
+sub is_repo {
+    my $repo = shift;
+    return -d "$repo/.git" || -d "$repo/.hg";
+}
diff --git a/bin/src-unregister b/bin/src-unregister
index 356c1f21..98413114 100755
--- a/bin/src-unregister
+++ b/bin/src-unregister
@@ -1,69 +1,77 @@
 #!/usr/bin/perl
 
 # Script to remove repositories in ~/src, including removing their
-# entries from ~/src/.mrconfig.  Confirmation is required only if the
+# 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 warnings;
 use strict;
+use warnings;
 
-use Capture::Tiny 'tee_stdout';
-use Term::UI;
-use Tie::File;
-use File::chdir;
+use Cwd;
+use File::Basename;
+use File::Spec::Functions;
 
 die "need at least one argument" if ( @ARGV < 1 );
-chdir "$ENV{'HOME'}/src/";
-my $term = Term::ReadLine->new('brand');
-
-foreach my $repo ( @ARGV ) {
-    die "$repo does not exist" if ! ( -d $repo );
-    die "$repo is not a git or hg repo"
-      if ! ( -d "$repo/.git" || -d "$repo/.hg" );
+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 rely on calling `mr status` so ensure the repo is registered
+# 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);
 
-foreach my $repo ( @ARGV ) {
-    {
-        local $CWD = $repo;
-        system "mr register";
-        my $exit = $? >> 8;
-        if ($exit != 0) {
-            die;
-        }
+my @known_repos;
+open my $fh, "<", "$ENV{HOME}/.mrconfig";
+while (<$fh>) {
+    if (/^\[(src\/.+)\]$/) {
+        push @known_repos, catfile($ENV{HOME}, $1);
     }
-    (my $output, undef) = tee_stdout { system "mr -m -d $repo status" };
-    my $confirm = 1;
-    if (length($output)) {
-        $confirm = $term->ask_yn(
-                                 prompt => 'Delete unclean repo $repo?',
-                                 default => 'n',
-                                );
+}
+
+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`;
+    if (!$force && length $output > 0) {
+        print STDERR "$output";
+        die "repo $repo might contain work; pass -f to delete anyway\n";
     }
-    if ($confirm) {
-        my $in_block = 0;
-        tie my @lines, 'Tie::File', "$ENV{'HOME'}/src/.mrconfig"
-          or die "could not open ~/src/.mrconfig";
-        for (my $i = 0; $i < @lines; $i++) {
-            if ($lines[$i] =~ m/^\[(.*)\]$/) {
-                if ($1 eq $repo) {
-                    $in_block = 1;
-                } else {
-                    $in_block = 0;
-                }
-            }
-            if ($in_block) {
-                splice @lines, $i, 1;
-                $i--;
-            }
+    $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, $_;
         }
-        untie @lines;
-        system "rm -rf $repo ${repo}_*.orig.tar.*";
     }
+    close $fh;
+    open $fh, '>', $ini;
+    print $fh "$_\n" for @lines;
 }