first (incomplete) version of new src cleanup code

3 files changed, 93 insertions, 0 deletions

diff --git a/bin/locmaint b/bin/locmaint
index 7f4442b0..a90dd3ef 100755
--- a/bin/locmaint
+++ b/bin/locmaint
@@ -172,6 +172,19 @@ sub do_homedir {
                                                    );
         }
     }
+
+    # do this after in case reviewing the repos prompts me to save any
+    # files this would delete
+    src_cleanup();
+    # look for any files outside of repos that src_cleanup() didn't
+    # manage to clean up
+    interactive_ensure_subroutine(\&loose_src_files,
+                                  sub { my $loose = shift;
+                                        return !$loose;},
+                                  "$ENV{HOME}/src",
+                                  undef);
+
+
 }
 
 sub do_coldbkup {
@@ -206,3 +219,32 @@ sub empty_dir_or_list {
         return 0;
     }
 }
+
+=head2 loose_src_files()
+
+Check whether there are loose plain files outside of repos in ~/src,
+returning a true value if there are, a false value if not.  If there
+are, print them.
+
+=cut
+
+sub loose_src_files {
+    my @loose_src_files;
+    find({wanted => sub {
+              push @loose_src_files
+                unless -d
+                || (-f && /orig\.tar/)
+                || (-l && /orig\.tar/)
+                || /orig\.gbp\.tar/
+          }, preprocess => sub {
+              # don't look inside any repos
+              return grep { ! Local::Homedir::is_repo($_) } @_
+          }}, "$ENV{HOME}/src");
+    if (@loose_src_files == 0) {
+        return 0;
+    } else {
+        say_bold("The following files in ~/src should be cleaned up:");
+        print "  $_\n" for @loose_src_files;
+        return 1;
+    }
+}
diff --git a/bin/src-cleanup b/bin/src-cleanup
new file mode 100755
index 00000000..d6b04a24
--- /dev/null
+++ b/bin/src-cleanup
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use lib "$ENV{HOME}/lib/perl5";
+
+use Local::Homedir;
+
+exit src_cleanup();
diff --git a/lib/perl5/Local/Homedir.pm b/lib/perl5/Local/Homedir.pm
index f473b00d..924db8d5 100644
--- a/lib/perl5/Local/Homedir.pm
+++ b/lib/perl5/Local/Homedir.pm
@@ -111,6 +111,48 @@ sub src_register_all {
           }}, "src");
 }
 
+sub src_cleanup {
+    # TODO stop if no Dpkg::Changelog, Dpkg::Version
+
+    my @debian_source_repos;
+    find({wanted => sub {
+              return unless -f catfile("debian", "changelog");
+              my $changelog_entry = changelog_parse();
+              push @debian_source_repos,
+                {source => $changelog_entry->{source},
+                 dir => getcwd()};
+          }, preprocess => sub {
+              # once we've found a source package, don't search inside
+              # for more source packages
+              return (-f catfile("debian", "changelog")) ? () : @_;
+          }}, "$ENV{HOME}/src");
+    foreach my $debian_source_repo (@debian_source_repos) {
+        my $prefix = catfile($debian_source_repo->{dir}, "..",
+                             $debian_source_repo->{source} . "_");
+        unlink glob $prefix . "*" . $_
+          for ".dsc", ".diff.gz", ".upload", ".inmulti", ".changes", ".deb",
+          ".build", ".buildinfo", ".debian.tar.*", "[0-9~].tar.*";
+        # ^ last one is native package tarballs but not orig.tars,
+        # which are handled separately
+
+        # we keep the two most recent orig.tar
+        my @origs = sort {
+            $a =~ /_([^_]+)\.orig\.tar/;
+            my $ver_a = Dpkg::Version->new("$1");
+            $b =~ /_([^_]+)\.orig\.tar/;
+            my $ver_b = Dpkg::Version->new("$1");
+            version_compare($ver_b, $ver_a);
+        } glob("$prefix*.orig.tar.*");
+        if (@origs > 2) {
+            shift @origs;
+            shift @origs;
+            unlink for @origs;
+        }
+    }
+
+    # could also run `clean-patch-queues -y` here
+}
+
 sub say_block (*$$) {
     my ($fh, $block, $text) = @_;