# Copyright (c) 2021-2025, PostgreSQL Global Development Group

use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Utils;
use Test::More;

program_help_ok('pg_archivecleanup');
program_version_ok('pg_archivecleanup');
program_options_handling_ok('pg_archivecleanup');

my $tempdir = PostgreSQL::Test::Utils::tempdir;

# WAL file patterns created before running each sub-scenario.  "present"
# tracks if the file with "name" still exists or not after running
# pg_archivecleanup.
my @walfiles_verbose = (
 { name => '00000001000000370000000D', present => 0 },
 { name => '00000001000000370000000E', present => 1 });
my @walfiles_with_gz = (
 { name => '00000001000000370000000C.gz', present => 0 },
 { name => '00000001000000370000000D', present => 0 },
 { name => '00000001000000370000000D.backup', present => 1 },
 { name => '00000001000000370000000E', present => 1 },
 { name => '00000001000000370000000F.partial', present => 1 },
 { name => 'unrelated_file', present => 1 });
my @walfiles_for_clean_backup_history = (
 { name => '00000001000000370000000D', present => 0 },
 { name => '00000001000000370000000D.00000028.backup', present => 0 },
 { name => '00000001000000370000000E', present => 1 },
 { name => '00000001000000370000000F.partial', present => 1 },
 { name => 'unrelated_file', present => 1 });

sub create_files
{
 foreach my $fn (map { $_->{name} } @_)
 {
  open my $file, '>', "$tempdir/$fn" or die $!;

  print $file 'CONTENT';
  close $file;
 }
 return;
}

sub remove_files
{
 foreach my $fn (map { $_->{name} } @_)
 {
  unlink "$tempdir/$fn";
 }
 return;
}

command_fails_like(
 ['pg_archivecleanup'],
 qr/must specify archive location/,
 'fails if archive location is not specified');

command_fails_like(
 [ 'pg_archivecleanup', $tempdir ],
 qr/must specify oldest kept WAL file/,
 'fails if oldest kept WAL file name is not specified');

command_fails_like(
 [ 'pg_archivecleanup', 'notexist', 'foo' ],
 qr/archive location .* does not exist/,
 'fails if archive location does not exist');

command_fails_like(
 [ 'pg_archivecleanup', $tempdir, 'foo', 'bar' ],
 qr/too many command-line arguments/,
 'fails with too many command-line arguments');

command_fails_like(
 [ 'pg_archivecleanup', $tempdir, 'foo' ],
 qr/invalid file name argument/,
 'fails with invalid restart file name');

# Test a dry run, no files are physically removed, but logs are generated
# to show what would be removed.
{
 create_files(@walfiles_verbose);

 my $stderr;
 my $oldestkeptwalfile = '00000001000000370000000E';
 my $result = IPC::Run::run [
  'pg_archivecleanup', '--debug', '--dry-run', $tempdir,
  $oldestkeptwalfile
   ],
   '2>' => \$stderr;
 ok($result, "pg_archivecleanup dry run: exit code 0");

 for my $walpair (@walfiles_verbose)
 {
  if ($walpair->{present})
  {
   unlike(
    $stderr,
    qr/$walpair->{name}.*would be removed/,
    "pg_archivecleanup dry run for $walpair->{name}: matches");
  }
  else
  {
   like(
    $stderr,
    qr/$walpair->{name}.*would be removed/,
    "pg_archivecleanup dry run for $walpair->{name}: matches");
  }
 }
 foreach my $fn (map { $_->{name} } @walfiles_verbose)
 {
  ok(-f "$tempdir/$fn", "$fn not removed");
 }

 remove_files(@walfiles_verbose);
}

sub run_check
{
 local $Test::Builder::Level = $Test::Builder::Level + 1;

 my ($testdata, $oldestkeptwalfile, $test_name, @options) = @_;

 create_files(@$testdata);

 command_ok(
  [ 'pg_archivecleanup', @options, $tempdir, $oldestkeptwalfile ],
  "$test_name: runs");

 for my $walpair (@$testdata)
 {
  if ($walpair->{present})
  {
   ok(-f "$tempdir/$walpair->{name}",
    "$test_name:$walpair->{name} was not cleaned up");
  }
  else
  {
   ok(!-f "$tempdir/$walpair->{name}",
    "$test_name:$walpair->{name} was cleaned up");
  }
 }

 remove_files(@$testdata);
 return;
}

run_check(\@walfiles_with_gz, '00000001000000370000000E',
 'pg_archivecleanup', '-x.gz');
run_check(
 \@walfiles_with_gz,
 '00000001000000370000000E.partial',
 'pg_archivecleanup with .partial file', '-x.gz');
run_check(
 \@walfiles_with_gz,
 '00000001000000370000000E.00000020.backup',
 'pg_archivecleanup with .backup file', '-x.gz');
run_check(\@walfiles_for_clean_backup_history,
 '00000001000000370000000E',
 'pg_archivecleanup with --clean-backup-history', '-b');

done_testing();