#!/usr/bin/env perl

# test_findSharedSnapshot.pl
#
# Tests validateBackup's shared-snapshot resolution: findSharedSnapshot.
#
# validateBackup is a script, not a requireable module (unguarded top-level logic runs on load),
# so the function under test is copied here verbatim, per this project's "extract a sub into a
# stub harness" testing convention (see test_destroyedSourceDataset.pl). This function has no
# dependencies of its own (pure data in, data out) - no ZFS, ssh, or stubbing of any kind needed.
#
# IF YOU CHANGE validateBackup's copy of this function, change it here too.
#
# Author: R. W. Rodolico <rodo@dailydata.net>
# Created: September 2026

use strict;
use warnings;

my ( $passed, $failed ) = ( 0, 0 );

sub ok {
   my ( $condition, $description ) = @_;
   if ($condition) { print "  PASS: $description\n"; $passed++; }
   else            { print "  FAIL: $description\n"; $failed++; }
}

# ---------------------------------------------------------------------------------------------
# Function under test, copied verbatim from validateBackup
# ---------------------------------------------------------------------------------------------

sub findSharedSnapshot {
   my ( $activeSnaps, $backupSnaps, $excludeSnap ) = @_;

   my %onBackup = map { $_->{snap} => 1 } @{ $backupSnaps || [] };
   my @candidates;
   my $sharedCount = 0;
   foreach my $record ( @{ $activeSnaps || [] } ) {
      next unless $onBackup{ $record->{snap} };
      $sharedCount++;
      next if $excludeSnap ne '' && $record->{snap} =~ /$excludeSnap/;
      push @candidates, $record;
   }

   unless (@candidates) {
      return ( '', 0, $sharedCount
         ? "all $sharedCount shared snapshot(s) were excluded by excludeSnap"
         : 'no snapshot name exists on both sides' );
   }

   # newest first: creation descending, then listing order descending as a same-second tie-break
   @candidates = sort {
      ( $b->{creation} // 0 ) <=> ( $a->{creation} // 0 ) || $b->{index} <=> $a->{index}
   } @candidates;

   return ( $candidates[0]->{snap}, scalar(@candidates), '' );
}

# ---------------------------------------------------------------------------------------------
# Test helper: build a snapshot record the way ZFS_Utils::listSnapshots would
# ---------------------------------------------------------------------------------------------

sub rec {
   my ( $snap, $creation, $index ) = @_;
   return { snap => $snap, creation => $creation, index => $index };
}

# ---------------------------------------------------------------------------------------------
print "\n=== basic intersection and ordering ===\n";
# ---------------------------------------------------------------------------------------------
{
   my @active = ( rec( 'daily-09', 1000, 0 ), rec( 'daily-10', 2000, 1 ), rec( 'hourly-11', 3000, 2 ) );
   my @backup = ( rec( 'daily-09', 1000, 0 ), rec( 'daily-10', 2000, 1 ) );    # never got hourly-11
   my ( $snap, $count, $reason ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq 'daily-10', "the newest SHARED snapshot is chosen (hourly-11 exists only on active, so it's not a candidate)" );
   ok( $count == 2, "candidate count reflects only the shared snapshots (2), not the active side's full list (3)" );
   ok( $reason eq '', "no reason text on success" );
}
{
   # Ordering is by 'creation', NOT by name - a snapshot named to sort last alphabetically but
   # created earliest must still lose to a numerically-later creation time.
   my @active = ( rec( 'zzz-old', 5000000, 0 ), rec( 'aaa-new', 9999999, 1 ) );
   my @backup = ( rec( 'zzz-old', 5000000, 0 ), rec( 'aaa-new', 9999999, 1 ) );
   my ( $snap ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq 'aaa-new', "creation-time ordering wins over alphabetical name ordering" );
}

# ---------------------------------------------------------------------------------------------
print "\n=== excludeSnap ===\n";
# ---------------------------------------------------------------------------------------------
{
   my @active = ( rec( 'daily-09', 1000, 0 ), rec( 'hourly-10', 2000, 1 ) );
   my @backup = ( rec( 'daily-09', 1000, 0 ), rec( 'hourly-10', 2000, 1 ) );
   my ( $snap, $count ) = findSharedSnapshot( \@active, \@backup, '^hourly' );
   ok( $snap eq 'daily-09', "excludeSnap removes the newer hourly candidate, falling back to daily" );
   ok( $count == 1, "excluded snapshots do not count toward the candidate count" );
}
{
   # All shared snapshots excluded: distinguishable failure reason from "nothing shared at all".
   my @active = ( rec( 'hourly-09', 1000, 0 ), rec( 'hourly-10', 2000, 1 ) );
   my @backup = ( rec( 'hourly-09', 1000, 0 ), rec( 'hourly-10', 2000, 1 ) );
   my ( $snap, $count, $reason ) = findSharedSnapshot( \@active, \@backup, '^hourly' );
   ok( $snap eq '', "no usable snapshot when excludeSnap removes every shared candidate" );
   ok( $count == 0, "candidate count is 0, not the excluded count" );
   ok( $reason =~ /excluded by excludeSnap/, "reason distinguishes 'all excluded' from 'none shared'" );
   ok( $reason =~ /\b2\b/, "reason names how many were excluded (2)" );
}

# ---------------------------------------------------------------------------------------------
print "\n=== no shared snapshot at all ===\n";
# ---------------------------------------------------------------------------------------------
{
   my @active = ( rec( 'daily-09', 1000, 0 ) );
   my @backup = ( rec( 'daily-08', 900, 0 ) );
   my ( $snap, $count, $reason ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq '', "disjoint snapshot names yield no result" );
   ok( $reason eq 'no snapshot name exists on both sides', "reason correctly says none are shared (not 'excluded')" );
}
{
   my ( $snap, $count, $reason ) = findSharedSnapshot( [], [], '' );
   ok( $snap eq '' && $reason eq 'no snapshot name exists on both sides', "two empty snapshot lists behave like disjoint lists, not a crash" );
}

# ---------------------------------------------------------------------------------------------
print "\n=== undated snapshots (creation undef) ===\n";
# ---------------------------------------------------------------------------------------------
{
   # A hand-made snapshot with no parseable creation (should not happen with 'zfs list -p', but
   # the function must not assume it never will) is still usable when it's the only candidate.
   my @active = ( rec( '@premigration', undef, 0 ) );
   my @backup = ( rec( '@premigration', undef, 0 ) );
   my ( $snap, $count, $reason ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq '@premigration', "an undated snapshot is still returned when it is the only shared candidate" );
   ok( $reason eq '', "no failure is reported just because creation is undef" );
}
{
   # An undated candidate must never beat a dated one: undef is treated as epoch 0, i.e. the
   # oldest possible time, so a real dated snapshot always wins when both are shared.
   my @active = ( rec( '@premigration', undef, 0 ), rec( 'daily-10', 2000, 1 ) );
   my @backup = ( rec( '@premigration', undef, 0 ), rec( 'daily-10', 2000, 1 ) );
   my ( $snap, $count ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq 'daily-10', "a dated snapshot is preferred over an undated one (undef sorts as oldest, not newest)" );
   ok( $count == 2, "both are still counted as candidates" );
}

# ---------------------------------------------------------------------------------------------
print "\n=== same-second tie-break by listing index ===\n";
# ---------------------------------------------------------------------------------------------
{
   # Two snapshots with identical creation epoch: the one that appeared later in 'zfs list'
   # (higher index) is preferred as the tie-break, per the sort's documented second key.
   my @active = ( rec( 'first', 5000, 0 ), rec( 'second', 5000, 1 ) );
   my @backup = ( rec( 'first', 5000, 0 ), rec( 'second', 5000, 1 ) );
   my ( $snap ) = findSharedSnapshot( \@active, \@backup, '' );
   ok( $snap eq 'second', "same-second tie-break picks the higher listing index" );
}

print "\nTest Summary: $passed passed, $failed failed\n";
exit( $failed == 0 ? 0 : 1 );