Subversion Repositories zfs_utils

#!/usr/bin/env perl
use strict;
use warnings;
use File::Temp qw(tempdir);
use File::Spec;
use Cwd qw(abs_path);

my $td = tempdir(CLEANUP => 1);

# location of the cleanSnaps script (this test lives in the same directory)
my $here = abs_path(File::Spec->rel2abs("."));
my $clean = File::Spec->catfile($here, 'cleanSnaps');
unless (-e $clean) {
    die "Could not find cleanSnaps at $clean";
}

# If a snapshot list filename was provided on the command line, use that file as the
# source of snapshot names. Otherwise, create a fake zfs-list script with sample names.
my $snaplist_file = shift @ARGV;
my $fake;
if ($snaplist_file && -e $snaplist_file) {
    $fake = File::Spec->catfile($td, 'fake_zfs_list.sh');
    open my $fh, '>', $fake or die $!;
    print $fh "#!/bin/sh\ncat \"$snaplist_file\"\n";
    close $fh;
    chmod 0755, $fake;
} else {
    $fake = File::Spec->catfile($td, 'fake_zfs_list.sh');
    open my $fh, '>', $fake or die $!;
    print $fh <<'EOF';
#!/bin/sh
cat <<'SNAPS'
pool/fs@2025-01-01-3d
pool/fs@2025-12-10-3d
pool/fs@2025-12-14-2d
pool/fs@2025-11-01-snap-4w
pool/fs@2025-12-01_foo_1m
pool/fs@badname
pool/fs@2025-12-01T12:00:00_1h
pool/fs@prefix_2025-12-01 13:00:00_2h
SNAPS
EOF
    close $fh;
    chmod 0755, $fake;
}

# Run cleanSnaps in dry-run verbose mode with the fake ZFS command
local %ENV = %ENV;
$ENV{ZFS_CMD} = $fake;

# execute and capture output (use perl from the environment if available)
my $out;
if ($ENV{PERL}) {
    $out = qx{$ENV{PERL} -I. "$clean" -n -v 2>&1};
} else {
    $out = qx{perl "$clean" -n -v 2>&1};
}

print "=== cleanSnaps output ===\n$out\n";

my @lines = split /\n/, $out;
my @removed = map { s/^\s+//; $_ } grep { /^\s+\S+@/ } @lines;

my %removed = map { $_ => 1 } @removed;

my @should_be_removed = (
    'pool/fs@2025-01-01-3d',
    'pool/fs@2025-12-10-3d',
    'pool/fs@2025-11-01-snap-4w',
    'pool/fs@2025-12-01T12:00:00_1h',
    'pool/fs@prefix_2025-12-01 13:00:00_2h',
);

my @should_be_kept = (
    'pool/fs@2025-12-14-2d',
    'pool/fs@2025-12-01_foo_1m',
    'pool/fs@badname',
);

my $ok = 1;
for my $s (@should_be_removed) {
    unless ($removed{$s}) {
        print "FAIL: expected $s to be marked for removal\n";
        $ok = 0;
    }
}
for my $s (@should_be_kept) {
    if ($removed{$s}) {
        print "FAIL: expected $s to be kept but it was marked for removal\n";
        $ok = 0;
    }
}

if ($ok) {
    print "TEST PASS\n";
    exit 0;
} else {
    print "TEST FAIL\n";
    exit 1;
}