#!/usr/bin/env perl

# Regression tests for cleanupScripts/updateConfigKeys after its migration from a raw
# YAML::Tiny read-modify-write cycle to YAMLPatch (TESTING_automation.md 16.3). The old
# behavior re-sorted keys alphabetically, stripped comments, and re-quoted every scalar on
# every run - confirmed as the root cause of a real test failure (Part 18's #maxDelta
# comment, written by Step 0.5, was simply gone by the time Part 18 tried to uncomment it,
# because Part 15 had run this script in between). These tests confirm the migrated script
# preserves comments/formatting for everything it doesn't touch, and still has the same
# safety properties (backup-first, atomic rename, refuses cleanly instead of corrupting).
#
# The script is eval'd by sneakernet itself (see executeCleanupScript in sneakernet/sneakernet)
# rather than run as a subprocess, and detects that context via caller() to decide whether to
# return (result, errors) or print/exit. This harness replicates that exact invocation shape -
# calling it from within a sub gives it a defined caller(), and a lexical $programDefinition in
# that sub's scope is what the script's own nested eval finds to resolve the config file path
# (see the script's own comment on why that lookup is itself wrapped in an eval string).

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/..";
use File::Temp qw(tempdir);

my $passed = 0;
my $failed = 0;

sub ok {
    my ($cond, $desc) = @_;
    if ($cond) { print "  PASS: $desc\n"; $passed++; return 1; }
    else       { print "  FAIL: $desc\n"; $failed++; return 0; }
}

sub slurp {
    my ($path) = @_;
    open my $fh, '<', $path or die "cannot open $path: $!";
    local $/;
    return <$fh>;
}

my $scriptPath = "$FindBin::Bin/../sneakernet/cleanupScripts/updateConfigKeys";
my $scriptContent = slurp($scriptPath);

# Runs the real script text against $configFile with a custom @updates block, exactly as
# sneakernet's executeCleanupScript does (eval'd from within a sub, so caller() is true).
sub run_cleanup_script {
    my ($configFile, @updates) = @_;
    my $programDefinition = { configFileName => $configFile };
    my $patched = $scriptContent;
    my $block = "my \@updates = (\n" . join('', map { "    '$_',\n" } @updates) . ");";
    my $count = ($patched =~ s/my\s+\@updates\s*=\s*\([^)]*\)\s*;/$block/s);
    die "could not patch \@updates block" unless $count;
    return eval $patched;
}

my $CONFIG_TEXT = <<'YAML';
---
debug: '0'
dryrun: '0'
# statusFileBackups controls how many timestamped backups to keep
statusFileBackups: 5
source:
  hostname: test-source
  report:
    email: ''
datasets:
  ds1:
    dataset: ds1
    #maxDelta: 0.9
YAML

sub make_config {
    my $dir = tempdir(CLEANUP => 1);
    my $path = "$dir/sneakernet.conf.yaml";
    open my $fh, '>', $path or die $!;
    print {$fh} $CONFIG_TEXT;
    close $fh;
    return $path;
}

# ===========================================================================
print "=== updating an existing top-level key preserves everything else ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my ($result, $errors) = run_cleanup_script($configFile, 'debug=1');
    ok(defined($result) && $result =~ /Updated: debug/, 'result mentions the update')
        or print "    result: " . ($result // '(undef)') . "\n    errors: " . ($errors // '') . "\n";
    ok(!$errors, 'no errors reported') or print "    errors: $errors\n";
    my $text = slurp($configFile);
    ok($text =~ /^debug: ['"]?1['"]?$/m, 'debug is now 1 on disk');
    ok($text =~ /# statusFileBackups controls how many timestamped backups to keep/, 'an unrelated comment survives (the exact defect this migration fixes)');
    ok($text =~ /#maxDelta: 0\.9/, 'an unrelated commented-out key survives untouched');
    ok($text =~ /^statusFileBackups: 5$/m, 'an unrelated key is untouched, not re-quoted or reformatted');
}

# ===========================================================================
print "\n=== deleting an existing key ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my ($result, $errors) = run_cleanup_script($configFile, 'dryrun=DELETE');
    ok($result =~ /Deleted: dryrun/, 'result mentions the delete');
    ok(!$errors, 'no errors reported') or print "    errors: $errors\n";
    my $text = slurp($configFile);
    ok($text !~ /^dryrun:/m, 'dryrun is actually gone from the file');
}

# ===========================================================================
print "\n=== deleting a key that does not exist is reported, not a crash ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my $before = slurp($configFile);
    my ($result, $errors) = run_cleanup_script($configFile, 'does.not.exist=DELETE');
    ok(defined($errors) && $errors =~ /not found/i, 'errors report the key was not found')
        or print "    errors: " . ($errors // '(undef)') . "\n";
    ok(slurp($configFile) eq $before, 'the config file is completely untouched');
}

# ===========================================================================
print "\n=== creating a new key under an existing parent ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my ($result, $errors) = run_cleanup_script($configFile, 'source.report.subject=Rotated');
    ok($result =~ /Created: source\.report\.subject/, 'result mentions the create')
        or print "    result: " . ($result // '(undef)') . "\n    errors: " . ($errors // '') . "\n";
    ok(!$errors, 'no errors reported') or print "    errors: $errors\n";
    my $text = slurp($configFile);
    ok($text =~ /^\s+subject: Rotated$/m, 'the new key is actually on disk under source.report');
}

# ===========================================================================
print "\n=== creating a key whose PARENT also doesn't exist is refused, not a crash (documented limitation) ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my $before = slurp($configFile);
    my ($result, $errors) = run_cleanup_script($configFile, 'target.geli.poolname=newbackup');
    ok(defined($errors) && $errors =~ /Create failed/, 'the create failure is reported, not a die')
        or print "    errors: " . ($errors // '(undef)') . "\n";
    ok(slurp($configFile) eq $before, 'the config file is completely untouched');
}

# ===========================================================================
print "\n=== a timestamped backup is created and holds the OLD content ===\n";
# ===========================================================================
{
    my $configFile = make_config();
    my $dir = $configFile;
    $dir =~ s{/[^/]+$}{};
    my $before = slurp($configFile);
    run_cleanup_script($configFile, 'debug=9');
    opendir(my $dh, $dir) or die $!;
    my @backups = grep { /^sneakernet\.conf\.yaml\.bak\.\d+/ } readdir($dh);
    closedir $dh;
    ok(scalar(@backups) == 1, 'exactly one backup file was created');
    ok(slurp("$dir/$backups[0]") eq $before, 'the backup holds the pre-update content verbatim');
}

print "\n" . "=" x 70 . "\n";
print "Test Summary: $passed passed, $failed failed\n";
print "=" x 70 . "\n";

exit( $failed == 0 ? 0 : 1 );