package Local::Homedir;

# homedir management functions
#
# 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 code must be as portable as possible.  Only core perl modules.

use strict;
use warnings;
use autodie;

use Cwd qw(getcwd realpath);
use File::Find;
use File::Spec::Functions;
use Exporter 'import';
use File::Temp qw(tempfile);

our @EXPORT = qw( normalise_mrconfig src_register_all src_cleanup );

our %debian_source_repos;

sub normalise_mrconfig {
    my $master = $ENV{HOME} . "/src/dotfiles/.mrconfig.in";
    my $target = $ENV{HOME} . "/.mrconfig";

    unlink $target if -e $target and not -f $target;

    my %master_blocks = blocks_from_file($master);
    my %target_blocks = -f $target ? blocks_from_file($target) : ();

    my $warning = "DO NOT EDIT THIS BLOCK; automatically updated from";

    # filter out any DO NOT EDIT comments because if these blocks were
    # removed from ~/.mrconfig.in but the repos are still present on
    # this machine, those lines would be misleading
    $target_blocks{$_} =~ s/^# ($warning|  $master)\n//mg
      for keys %target_blocks;

    for (keys %master_blocks) {
        $target_blocks{$_} = "# $warning\n#   $master\n" . join "\n",
          grep !/^\s*#|^\s*$/, split "\n", $master_blocks{$_};
    }

    open my $fh, '>', $target;
    print $fh "# -*- mode: conf -*-\n";

    # any DEFAULT has to come first to have effect on the proceding
    # blocks
    say_block($fh, "DEFAULT", delete $target_blocks{DEFAULT})
      if $target_blocks{DEFAULT};
    say_block($fh, $_, $target_blocks{$_}) for keys %target_blocks;

    return 0;
}

sub blocks_from_file ($) {
    my $file = shift;

    my %blocks;
    my $current_block;
    open my $fh, '<', $file;
    while (<$fh>) {
        if (/^\[(.+)\]$/) {
            $current_block = $1;
        } elsif (defined $current_block) {
            $blocks{$current_block} .= $_;
        }
    }
    # drop trailing newlines from the text of each block
    { local $/ = ''; chomp $blocks{$_} foreach keys %blocks }
    return %blocks;
}

sub src_register_all {
    chdir;
    my @known_repos;
    foreach my $f (".mrconfig", "src/dotfiles/lib-src/mr/config") {
	open my $fh, "<", $f;
	while (<$fh>) {
	    if (/^\[(src\/.+)\]$/) {
		push @known_repos, $ENV{HOME}."/$1";
	    }
	}
    }
    find({wanted => sub {
              return unless is_repo($_);
	      my $oldpwd = getcwd;
              chdir $_;
              my $register_out = `mr -c $ENV{HOME}/.mrconfig register 2>&1`;
              unless ($? == 0) {
                  print STDERR "mr register: $File::Find::name\n";
                  print STDERR $register_out."\n";
                  die "src_register_all mr register attempt failed";
              }
              chdir $oldpwd;
          }, preprocess => sub {
              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;
          }}, "src");
}

sub src_cleanup {
    return unless eval "use Dpkg::Changelog::Parse; use Dpkg::Version; 1";

    find({
            wanted => sub {
                my $dir = $_;
                my $ch = catfile($dir, "debian", "changelog");

                # if no changelog on the current branch, see if there is
                # one on another relevant branch (this covers ~/src/p5-*)
                unless (-f $ch) {
                    return unless is_repo($dir);
                    my @branches
                      = grep
                      m#^refs/(?:heads/debian$|(?:heads|remotes/dgit)/dgit/)#,
`git -C $dir for-each-ref --format='%(refname)' refs/heads/ refs/remotes/dgit/`;
                    chomp @branches;
                    my $branch;
                    for (@branches) {
                        $branch = $_, last
                          if grep m#debian/changelog#,
                          `git -C $dir ls-tree $_ debian/changelog`;
                    }
                    return unless $branch;
                    (my $fh, $ch) = tempfile UNLINK => 1;
                    open my $ph, "-|", "git", "-C", $dir, "cat-file", "blob",
                      "$branch:debian/changelog";
                    print $fh $_ for <$ph>;
                    close $fh;
                }

                my $changelog_entry = changelog_parse(file => $ch);
                $debian_source_repos{ $changelog_entry->{source} }
                  = catfile getcwd, $dir;
            },
            preprocess => sub {
                # skip .git (to avoid .git/dgit/unpack dirs), and once
                # we've found a source package, don't search inside
                # for more source packages
                -f catfile("debian", "changelog")
                  ? ()
                  : grep { $_ ne ".git" } @_
            }
        },
        "$ENV{HOME}/src"
    );
    while (my ($source, $dir) = each %debian_source_repos) {
        # binary package names may not be source package names, so
        # have to handle those separately
        unlink glob catfile $dir, "..", "*.deb";
        my $prefix = catfile $dir, "..", $source . "_";
        unlink glob $prefix . "*" . $_
          for ".dsc", ".diff.gz", ".upload", ".inmulti", ".changes",
          ".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);
        } grep !/\.asc\z/, map realpath($_), glob "$prefix*.orig.tar.*";
        if (@origs > 2) {
            shift @origs;
            shift @origs;
            for (@origs) {
                unlink $_;
                unlink "$_.asc" if -e "$_.asc";
            }
        }
    }

    # could also run `clean-patch-queues -y` here
}

sub say_block (*$$) {
    my ($fh, $block, $text) = @_;

    print $fh "\n[$block]\n";
    print $fh $text;
    print $fh "\n";
}

sub is_repo { -e "$_[0]/.git" or -d "$_[0]/.hg" }

1;