Subversion Repositories zfs_utils

Rev

Rev 51 | Rev 54 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
51 rodolico 1 
#!/usr/bin/env perl
2 
use strict;
3 
use warnings;
4 
use File::Temp qw(tempdir);
5 
use File::Spec;
6 
use Cwd qw(abs_path);
7 
 
8 
my $td = tempdir(CLEANUP => 1);
9 
 
10 
# location of the cleanSnaps script (this test lives in the same directory)
11 
my $here = abs_path(File::Spec->rel2abs("."));
12 
my $clean = File::Spec->catfile($here, 'cleanSnaps');
13 
unless (-e $clean) {
14 
    die "Could not find cleanSnaps at $clean";
15 
}
16 
 
17 
# If a snapshot list filename was provided on the command line, use that file as the
18 
# source of snapshot names. Otherwise, create a fake zfs-list script with sample names.
19 
my $snaplist_file = shift @ARGV;
20 
my $fake;
21 
if ($snaplist_file && -e $snaplist_file) {
22 
    $fake = File::Spec->catfile($td, 'fake_zfs_list.sh');
23 
    open my $fh, '>', $fake or die $!;
24 
    print $fh "#!/bin/sh\ncat \"$snaplist_file\"\n";
25 
    close $fh;
26 
    chmod 0755, $fake;
27 
} else {
28 
    $fake = File::Spec->catfile($td, 'fake_zfs_list.sh');
29 
    open my $fh, '>', $fake or die $!;
30 
    print $fh <<'EOF';
31 
#!/bin/sh
32 
cat <<'SNAPS'
33 
pool/fs@2025-01-01-3d
34 
pool/fs@2025-12-10-3d
35 
pool/fs@2025-12-14-2d
36 
pool/fs@2025-11-01-snap-4w
37 
pool/fs@2025-12-01_foo_1m
38 
pool/fs@badname
39 
pool/fs@2025-12-01T12:00:00_1h
40 
pool/fs@prefix_2025-12-01 13:00:00_2h
41 
SNAPS
42 
EOF
43 
    close $fh;
44 
    chmod 0755, $fake;
45 
}
46 
 
47 
# Run cleanSnaps in dry-run verbose mode with the fake ZFS command
48 
local %ENV = %ENV;
49 
$ENV{ZFS_CMD} = $fake;
50 
 
51 
# execute and capture output (use perl from the environment if available)
52 
my $out;
53 
if ($ENV{PERL}) {
54 
    $out = qx{$ENV{PERL} -I. "$clean" -n -v 2>&1};
55 
} else {
56 
    $out = qx{perl "$clean" -n -v 2>&1};
57 
}
58 
 
59 
print "=== cleanSnaps output ===\n$out\n";
60 
 
61 
my @lines = split /\n/, $out;
62 
my @removed = map { s/^\s+//; $_ } grep { /^\s+\S+@/ } @lines;
63 
 
64 
my %removed = map { $_ => 1 } @removed;
65 
 
66 
my @should_be_removed = (
67 
    'pool/fs@2025-01-01-3d',
68 
    'pool/fs@2025-12-10-3d',
69 
    'pool/fs@2025-11-01-snap-4w',
70 
    'pool/fs@2025-12-01T12:00:00_1h',
71 
    'pool/fs@prefix_2025-12-01 13:00:00_2h',
72 
);
73 
 
74 
my @should_be_kept = (
75 
    'pool/fs@2025-12-14-2d',
76 
    'pool/fs@2025-12-01_foo_1m',
77 
    'pool/fs@badname',
78 
);
79 
 
80 
my $ok = 1;
81 
for my $s (@should_be_removed) {
82 
    unless ($removed{$s}) {
83 
        print "FAIL: expected $s to be marked for removal\n";
84 
        $ok = 0;
85 
    }
86 
}
87 
for my $s (@should_be_kept) {
88 
    if ($removed{$s}) {
89 
        print "FAIL: expected $s to be kept but it was marked for removal\n";
90 
        $ok = 0;
91 
    }
92 
}
93 
 
94 
if ($ok) {
95 
    print "TEST PASS\n";
96 
    exit 0;
97 
} else {
98 
    print "TEST FAIL\n";
99 
    exit 1;
100 
}