#!/usr/bin/perl

use strict;
use warnings;
use POSIX qw(locale_h);
use Test::More;
use Time::Piece;
use Time::Seconds qw(ONE_MONTH ONE_YEAR);

use File::Basename qw(dirname);
use lib dirname(dirname(__FILE__));
use Test::DH;

use constant TEST_DIR => dirname($0);
our @TEST_DH_EXTRA_TEMPLATE_FILES = (qw(
	debian/NEWS
	debian/changelog
	debian/control
));

# Force Time::Piece to generate dch-compliant timestamps (i.e. in English).
setlocale(LC_ALL, "C.UTF-8");

use constant CUTOFF_DATE_STR => "2019-07-06"; # oldstable = Debian 10 Buster
use constant CUTOFF_DATE => Time::Piece->strptime(CUTOFF_DATE_STR, "%Y-%m-%d");
use constant MIN_NUM_ENTRIES => 4;

sub install_changelog {
	my ($latest_offset_years, $num_years, $is_binnmu) = @_;
	my $changesfile = "${\TEST_DIR}/debian/changelog";
	install_changesfile($changesfile, $latest_offset_years, $num_years, $is_binnmu);
}
sub install_news {
	my ($latest_offset_years, $num_years, $is_binnmu) = @_;
	my $changesfile = "${\TEST_DIR}/debian/NEWS";
	install_changesfile($changesfile, $latest_offset_years, $num_years, $is_binnmu);
}
sub install_changesfile {
	my ($changesfile, $latest_offset_years, $num_years, $is_binnmu) = @_;
	$is_binnmu //= 0;

	my $entry_date_first = CUTOFF_DATE->add_years($latest_offset_years);
	my $entry_date_stop = $entry_date_first->add_years(-$num_years);

	open(my $fd, ">", $changesfile) or error("open($changesfile): $!");

	if ($is_binnmu) {
		my $nmu_date = $entry_date_first->add_months(-1);
		my $nmu_entry = entry_text($nmu_date, 1);
		print($fd $nmu_entry);
	}

	# Add one entry every three months ~= four per year.
	my $entry_date = $entry_date_first;
	while ($entry_date > $entry_date_stop) {
		my $entry = entry_text($entry_date, 0);
		print($fd $entry);

		$entry_date = $entry_date->add_months(-3);
	}
	close($fd);
}

sub entry_text {
	my ($entry_date, $is_binnmu) = @_;
	my $entry_date_str = $entry_date->strftime("%a, %d %b %Y %T %z");
	my $ver = $entry_date->year . "." . $entry_date->mon . "-1";
	my $binnmu_text = "";

	if ($is_binnmu) {
		$binnmu_text = " binary-only=yes";
		$ver .= "+b1";
	}

	my $entry = "";
	$entry .= "foo ($ver) unstable; urgency=low$binnmu_text\n\n";
	$entry .= "  * New release.\n\n";
	$entry .= " -- Test <testing\@nowhere>  $entry_date_str\n\n";

	return $entry;
}

sub changelog_lines_pkg {
	return changesfile_lines("debian/changelog");
}
sub changelog_lines_installed {
	return changesfile_lines("debian/foo/usr/share/doc/foo/changelog.Debian");
}
sub changelog_lines_binnmu {
	return changesfile_lines("debian/foo/usr/share/doc/foo/changelog.Debian.all");
}
sub news_lines_pkg {
	return changesfile_lines("debian/NEWS");
}
sub news_lines_installed {
	return changesfile_lines("debian/foo/usr/share/doc/foo/NEWS.Debian");
}
sub changesfile_lines {
	my ($changelog) = @_;
	open(my $fd, $changelog) or error("open($changelog): $!");
	my @lines = @{readlines($fd)};
	@lines = grep(!/^$/, @lines);
	return @lines;
}

sub dates_in_lines {
	my @lines = @_;
	my @lines_dates = grep(/^ -- /, @lines);
	@lines_dates = map { (my $l = $_) =~ s/^\s*--\s+.*?\s+<[^>]*>\s+[A-Za-z]+, +//; $l }  @lines_dates;
	@lines_dates = map { Time::Piece->strptime($_, "%d %b %Y %T %z") }  @lines_dates;
	return @lines_dates;
}

plan(tests => 9);

# Test changelog with only recent entries (< oldstable)
my $years_after_cutoff = 2;
my $years_of_changelog = 2;
install_changelog($years_after_cutoff, $years_of_changelog);
install_news($years_after_cutoff, $years_of_changelog);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @news_orig = news_lines_pkg();
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @comments = grep(/^#/, @lines);
	my @news = news_lines_installed();

	is(@lines, @lines_orig);
	is(@comments, 0);
	is(@news, @news_orig);
};

# Test changelog with both recent and old entries
$years_after_cutoff = 1;
$years_of_changelog = 4;
install_changelog($years_after_cutoff, $years_of_changelog);
install_news($years_after_cutoff, $years_of_changelog);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @news_orig = news_lines_pkg();
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @comments = grep(/^#/, @lines);
	my @news = news_lines_installed();
	my @news_entries = dates_in_lines(@news);
	my @news_entries_old = grep { $_ < CUTOFF_DATE } @entries;

	cmp_ok(@lines, "<", @lines_orig);
	cmp_ok(@entries, ">", 1);
	is(@entries_old, 0);
	cmp_ok(@comments, ">=", 1);

	cmp_ok(@news, "<", @news_orig);
	cmp_ok(@news_entries, ">", 1);
	is(@news_entries_old, 0);
};

# Test changelog with only old entries
$years_after_cutoff = -1;
$years_of_changelog = 2;
install_changelog($years_after_cutoff, $years_of_changelog);
install_news($years_after_cutoff - 2, 1);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @comments = grep(/^#/, @lines);

	cmp_ok(@lines, "<", @lines_orig);
	is(@entries, MIN_NUM_ENTRIES);
	is(@entries_old, MIN_NUM_ENTRIES);
	cmp_ok(@comments, ">=", 1);

	# All entries in NEWS are old, so it should not be installed.
	ok(! -f "debian/foo/usr/share/doc/foo/NEWS.Debian");
};

# Test changelog with only recent entries (< oldstable) + binNUM
$years_after_cutoff = 2;
$years_of_changelog = 2;
install_changelog($years_after_cutoff, $years_of_changelog, 1);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @entries_orig = dates_in_lines(@lines_orig);
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_nmu = dates_in_lines(changelog_lines_binnmu());
	my @comments = grep(/^#/, @lines);

	is(@entries, @entries_orig-1);
	is($entries[0], $entries_orig[1]);
	is(@comments, 0);

	is(@entries_nmu, 1);
};

# Test changelog with both recent and old entries + binNMU
$years_after_cutoff = 1;
$years_of_changelog = 4;
install_changelog($years_after_cutoff, $years_of_changelog, 1);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @entries_orig = dates_in_lines(@lines_orig);
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @entries_nmu = dates_in_lines(changelog_lines_binnmu());
	my @comments = grep(/^#/, @lines);

	cmp_ok(@entries, "<", @entries_orig-1);
	is($entries[0], $entries_orig[1]);
	is(@entries_old, 0);
	cmp_ok(@comments, ">=", 1);

	is(@entries_nmu, 1);
};

# Test changelog with only old entries + binNMU
$years_after_cutoff = -1;
$years_of_changelog = 2;
install_changelog($years_after_cutoff, $years_of_changelog, 1);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @entries_orig = dates_in_lines(@lines_orig);
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @entries_nmu = dates_in_lines(changelog_lines_binnmu());
	my @comments = grep(/^#/, @lines);

	is(@entries, MIN_NUM_ENTRIES);
	is($entries[0], $entries_orig[1]);
	is(@entries_old, MIN_NUM_ENTRIES);
	cmp_ok(@comments, ">=", 1);

	is(@entries_nmu, 1);
};

# Test changelog with both recent and old entries + --no-trim
$years_after_cutoff = 1;
$years_of_changelog = 4;
install_changelog($years_after_cutoff, $years_of_changelog);
install_news($years_after_cutoff, $years_of_changelog);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @news_orig = news_lines_pkg();
	ok(run_dh_tool("dh_installchangelogs", "--no-trim"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @comments = grep(/^#/, @lines);
	my @news = news_lines_installed();
	my @news_entries = dates_in_lines(@news);
	my @news_entries_old = grep { $_ < CUTOFF_DATE } @entries;

	is(@lines, @lines_orig);
	cmp_ok(@entries, ">", 1);
	cmp_ok(@entries_old, ">", 1);
	is(@comments, 0);

	is(@news, @news_orig);
	cmp_ok(@news_entries, ">", 1);
	cmp_ok(@news_entries_old, ">", 1);
};

# Test changelog with both recent and old entries + binNMU + --no-trim
$years_after_cutoff = 1;
$years_of_changelog = 4;
install_changelog($years_after_cutoff, $years_of_changelog, 1);
install_news($years_after_cutoff, $years_of_changelog);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @entries_orig = dates_in_lines(@lines_orig);
	my @news_orig = news_lines_pkg();
	ok(run_dh_tool("dh_installchangelogs", "--no-trim"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_nmu = dates_in_lines(changelog_lines_binnmu());
	my @comments = grep(/^#/, @lines);
	my @news = news_lines_installed();
	my @news_entries = dates_in_lines(@news);

	is(@entries, @entries_orig-1);
	is($entries[0], $entries_orig[1]);
	is(@comments, 0);

	is(@entries_nmu, 1);

	is(@news, @news_orig);
};

# Test changelog with both recent and old entries + notrimdch
$years_after_cutoff = 1;
$years_of_changelog = 4;
install_changelog($years_after_cutoff, $years_of_changelog);
install_news($years_after_cutoff, $years_of_changelog);
each_compat_subtest {
	my @lines_orig = changelog_lines_pkg();
	my @news_orig = news_lines_pkg();
	$ENV{DEB_BUILD_OPTIONS} = "notrimdch";
	ok(run_dh_tool("dh_installchangelogs"));
	my @lines = changelog_lines_installed();
	my @entries = dates_in_lines(@lines);
	my @entries_old = grep { $_ < CUTOFF_DATE } @entries;
	my @comments = grep(/^#/, @lines);
	my @news = news_lines_installed();
	my @news_entries = dates_in_lines(@news);
	my @news_entries_old = grep { $_ < CUTOFF_DATE } @entries;

	is(@lines, @lines_orig);
	cmp_ok(@entries, ">", 1);
	cmp_ok(@entries_old, ">", 1);
	is(@comments, 0);

	is(@news, @news_orig);
	cmp_ok(@news_entries, ">", 1);
	cmp_ok(@news_entries_old, ">", 1);
};

unlink("${\TEST_DIR}/debian/changelog");
unlink("${\TEST_DIR}/debian/NEWS");
