#!/usr/bin/env perl

# Copyright (c) 2025, R. W. Rodolico
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
#
# t/sensors_havirt.t
# Tests for sensors/linux_havirt, from fixtures only (no real havirt).
#
# Revision History:
# 2026-10-13 Claude v1.0.0 initial havirt sensor tests
# 2026-10-18 Claude bug 210 stage 2: unix_havirt renamed linux_havirt

use strict;
use warnings;
use Test::More;
use lib './unix';
no warnings 'once';
use File::Temp qw(tempdir);

use lib './t';
use fixture_report_helper;

require './unix/sensors/linux_havirt';

my $dir = 't/fixtures/havirt-node';
my $nodeText = fixture_report_helper::slurpFile("$dir/havirt_node_list_--format_tsv.txt");
my $domText = fixture_report_helper::slurpFile("$dir/havirt_domain_list_--extended_--format_tsv.txt");
my $hostname = fixture_report_helper::slurpFile("$dir/hostname.txt");
$hostname =~ s/\s+$//;
ok(length($nodeText) && length($domText) && $hostname eq 'dd-121', 'fixtures present');

# 1. parseTsvTable
my $nodeRows = linux_havirt::parseTsvTable($nodeText);
my $domRows = linux_havirt::parseTsvTable($domText);
is(scalar(@{$domRows}), 24, 'extended list has 24 summary rows');
my ($clara) = grep { $_->{'Domain'} eq 'clara.example.net' } @{$domRows};
is($clara->{'Node'}, 'dd-121', 'clara on dd-121');
is($clara->{'vnc'}, '5900', 'clara vnc');
is($clara->{'maintenance'}, '', 'clara maintenance empty');
is(scalar(@{$clara->{'nics'}}), 1, 'clara one NIC');
is(scalar(@{$clara->{'disks'}}), 2, 'clara two disks');

# 2. matchNode
my @names = map { $_->{'Node'} } @{$nodeRows};
is(linux_havirt::matchNode('dd-121', \@names), 'dd-121', 'exact match');
is(linux_havirt::matchNode('DD-121.example.net', \@names), 'dd-121', 'short label, case-insensitive');
is(linux_havirt::matchNode('dd-999', \@names), undef, 'no match');

# 3-5. buildLines for dd-121
my $lines = linux_havirt::buildLines($nodeRows, $domRows, 'dd-121');
my %domains;
foreach my $l (@{$lines}) {
   my @f = split(/\t/, $l);
   $domains{$f[1]} = 1 if $f[0] eq 'havirt_domain';
}
is(scalar(keys %domains), 13, '13 domains on dd-121');
is(scalar(grep { /ts\.example\.net|router-b\.example\.net/ } @{$lines}), 0, 'no guests of other nodes');

my %have = map { $_ => 1 } @{$lines};
my $dis = 'havirt_domain' . "\t" . 'clara.example.net' . "\t";
my @expected = (
   "havirt_node\tname\tdd-121",
   "havirt_node\tmemory\t264016384",
   "havirt_node\tthreads_per_core\t2",
   "${dis}memory\t8388608",
   "${dis}vcpu\t4",
   "${dis}vnc\t5900",
   "${dis}nic_count\t1",
   "${dis}nic\t00:16:3e:df:ec:ab\tbr_dmz",
   "${dis}disk\tsda\ttype\tblock",
   "${dis}disk\tsda\tsource\t/dev/disk/by-path/ip-10.53.148.66:3260-iscsi-iqn.2024-10.net.dd-nas0:clara0-lun-0",
);
ok($have{$_}, "line present: $_") foreach @expected;

is(scalar(grep { /\t$/ } @{$lines}), 0, 'no line ends in an empty field');
is(scalar(grep { /^[^\t]+\t(?:[^\t]+\t)*maintenance\t/ } @{$lines}), 0, 'no maintenance key');
is(scalar(grep { /vnet/ } @{$lines}), 0, 'no vnet names');

# 6. dd-107
my $l107 = linux_havirt::buildLines($nodeRows, $domRows, 'dd-107');
my $ts = "havirt_domain\tts.example.net\t";
my %h107 = map { $_ => 1 } @{$l107};
ok($h107{"${ts}nic\t00:16:3e:15:9c:89\tbr_lan"}, 'ts first NIC by MAC');
ok($h107{"${ts}nic\t00:16:3e:15:9c:8a\tbr_nfs"}, 'ts second NIC by MAC');
ok($h107{"${ts}disk\tsdc\tsource\tunknown"}, 'ts sdc source unknown');

# 7. inline: maintenance 1, upper-case MAC
my $nr = linux_havirt::parseTsvTable("Node\tmaintenance\tmemory\nn1\t1\t100\n");
my $dr = linux_havirt::parseTsvTable("Node\tDomain\tvcpu\nn1\tg1\t2\n  NICs:\n    eth0\tbr0\t00:16:3E:AA:BB:CC\n");
my $inline = linux_havirt::buildLines($nr, $dr, 'n1');
ok((grep { $_ eq "havirt_node\tmaintenance\t1" } @{$inline}), 'maintenance 1 present');
ok((grep { $_ eq "havirt_domain\tg1\tnic\t00:16:3e:aa:bb:cc\tbr0" } @{$inline}), 'MAC lower-cased');

# 8. field counts and tree
my $bad = grep { my @f = split(/\t/, $_, -1); @f < 3 || @f > 6 } @{$lines};
is($bad, 0, 'every line has 3-6 fields');
my $tree = {};
fixture_report_helper::applyTabLines($tree, $lines);
my $src = $tree->{'havirt_domain'}{'clara.example.net'}{'disk'}{'sda'}{'source'};
ok(defined($src) && !ref($src), 'disk source is a scalar in the tree');

# 9. main exit codes with commands stubbed
my %stub;
{
   no warnings 'redefine';
   *linux_havirt::runCommand = sub {
      my @cmd = @_;
      my $key = $cmd[0] eq 'hostname' ? 'hostname' : join(' ', @cmd[1 .. $#cmd]);
      my $r = $stub{$key};
      $? = ($r->{'status'} || 0) << 8;
      return $r->{'out'};
   };
}
my $bin = tempdir(CLEANUP => 1);
my $fake = "$bin/havirt";
open(my $fh, '>', $fake) or die; close($fh);
chmod 0755, $fake;
%stub = (
   'hostname' => { 'out' => "dd-121\n" },
   'node list --format tsv' => { 'out' => $nodeText },
   'domain list --extended --format tsv' => { 'out' => $domText },
);

sub runMain {
   my $out = '';
   open(my $saved, '>&', \*STDOUT) or die;
   close(STDOUT);
   open(STDOUT, '>', \$out) or die;
   my $rc;
   { local *STDERR; open(STDERR, '>', \my $err); $rc = linux_havirt::main(); }
   close(STDOUT);
   open(STDOUT, '>&', $saved) or die;
   return ($rc, $out);
}

{
   local $ENV{'PATH'} = $bin;
   my ($rc, $out) = runMain();
   is($rc, 0, 'main ok with havirt present');
   ok(length($out), 'main prints lines');
}
{
   local $ENV{'PATH'} = tempdir(CLEANUP => 1);
   local $linux_havirt::fallbackHavirt = "$bin/nonexistent";
   my ($rc) = runMain();
   is($rc, 2, 'havirt not found -> 2 (not applicable)');
}
{
   local $ENV{'PATH'} = $bin;
   local $stub{'hostname'} = { 'out' => "dd-999\n" };
   my ($rc) = runMain();
   is($rc, 2, 'not a havirt node -> 2 (not applicable)');
}
{
   local $ENV{'PATH'} = $bin;
   local $stub{'node list --format tsv'} = { 'out' => '', 'status' => 1 };
   my ($rc) = runMain();
   is($rc, 4, 'havirt non-zero -> 4 (error)');
}
{
   local $ENV{'PATH'} = $bin;
   local $stub{'domain list --extended --format tsv'} = { 'out' => '' };
   my ($rc) = runMain();
   is($rc, 4, 'no header -> 4 (error)');
}
{
   local $ENV{'PATH'} = $bin;
   local $stub{'hostname'} = { 'out' => "dd-107\n" };
   local $stub{'domain list --extended --format tsv'} = { 'out' => "Node\tDomain\tvcpu\ndd-127\tg\t1\n" };
   my ($rc, $out) = runMain();
   is($rc, 0, 'node without guests -> 0');
   is(scalar(grep { !/^havirt_node\t/ } split(/\n/, $out)), 0, 'only havirt_node lines');
}

done_testing();
