[pve-devel] [PATCH v3 pve-common 09/12] test: add tests for file path operation functions of PVE::Path

[Max Carrara <m.carrara@proxmox.com>]

Add tests for the functions path_file_name, path_file_prefix,
path_file_suffix and path_file_suffixes as well as their path_with_*
counterparts.

The cases defined here are a bit more elaborate than the others,
because manipulating file names specifically is more insidious as one
might think at first.

For example, getting the suffix of a file like /etc/resolv.conf is
rather trivial, as one can e.g. just take the last component and split
it at the dot, but for files like /foo/bar/...oh...no.. (yes, this has
a valid file name) it's much more tricker and can't actually be
performed via Perl's inbuilt split function.

That's why some of the cases added here account for weird file names,
files with more than two suffixes, etc. The functions above must of
course always work in a consistent manner, even if a file starts with
leading dots or has an arbitrarily high number of suffixes.

Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v2 --> v3:
  * Adapt code accordingly since path_file_suffixes and path_file_parts
    don't return a list ref in scalar context anymore

Changes v1 --> v2:
  * NEW: Split from patch 02

 test/Path/Makefile               |    1 +
 test/Path/path_file_ops_tests.pl | 1226 ++++++++++++++++++++++++++++++
 2 files changed, 1227 insertions(+)
 create mode 100755 test/Path/path_file_ops_tests.pl

diff --git a/test/Path/Makefile b/test/Path/Makefile
index 627dc09..9dcb878 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,6 +1,7 @@
 TESTS = \
 	path_comparison_tests.pl				\
 	path_components_tests.pl				\
+	path_file_ops_tests.pl					\
 	path_is_absolute_relative_tests.pl			\
 	path_join_tests.pl					\
 	path_parent_tests.pl					\
diff --git a/test/Path/path_file_ops_tests.pl b/test/Path/path_file_ops_tests.pl
new file mode 100755
index 0000000..a3a7a59
--- /dev/null
+++ b/test/Path/path_file_ops_tests.pl
@@ -0,0 +1,1226 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_file_part_cases = [
+    {
+	name => "empty path",
+	path => "",
+	file_name => undef,
+	file_prefix => undef,
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => [],
+    },
+    {
+	name => "root",
+	path => "/",
+	file_name => undef,
+	file_prefix => undef,
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => [],
+    },
+    {
+	name => "file without suffixes",
+	path => "foo",
+	file_name => "foo",
+	file_prefix => "foo",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => ["foo"],
+    },
+    {
+	name => "file without suffixes, with root",
+	path => "/foo",
+	file_name => "foo",
+	file_prefix => "foo",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => ["foo"],
+    },
+    {
+	name => "file with suffixes (1)",
+	path => "foo.txt",
+	file_name => "foo.txt",
+	file_prefix => "foo",
+	file_suffix => "txt",
+	file_suffixes => ["txt"],
+	file_parts => ["foo", "txt"],
+    },
+    {
+	name => "file with suffixes (3)",
+	path => "foo.txt.zip.zst",
+	file_name => "foo.txt.zip.zst",
+	file_prefix => "foo",
+	file_suffix => "zst",
+	file_suffixes => ["txt", "zip", "zst"],
+	file_parts => ["foo", "txt", "zip", "zst"],
+    },
+    {
+	name => "file with suffixes (1), with root",
+	path => "/foo.txt",
+	file_name => "foo.txt",
+	file_prefix => "foo",
+	file_suffix => "txt",
+	file_suffixes => ["txt"],
+	file_parts => ["foo", "txt"],
+    },
+    {
+	name => "file with suffixes (3), with root",
+	path => "/foo.txt.zip.zst",
+	file_name => "foo.txt.zip.zst",
+	file_prefix => "foo",
+	file_suffix => "zst",
+	file_suffixes => ["txt", "zip", "zst"],
+	file_parts => ["foo", "txt", "zip", "zst"],
+    },
+    {
+	name => "/etc/resolv.conf - simple file with single dir",
+	path => "/etc/resolv.conf",
+	file_name => "resolv.conf",
+	file_prefix => "resolv",
+	file_suffix => "conf",
+	file_suffixes => ["conf"],
+	file_parts => ["resolv", "conf"],
+    },
+    {
+	name => "/etc/pve/firewall/cluster.fw - long path",
+	path => "/etc/pve/firewall/cluster.fw",
+	file_name => "cluster.fw",
+	file_prefix => "cluster",
+	file_suffix => "fw",
+	file_suffixes => ["fw"],
+	file_parts => ["cluster", "fw"],
+    },
+    {
+	name => "/tmp/archive.tar.gz - file with two suffixes",
+	path => "/tmp/archive.tar.gz",
+	file_name => "archive.tar.gz",
+	file_prefix => "archive",
+	file_suffix => "gz",
+	file_suffixes => ["tar", "gz"],
+	file_parts => ["archive", "tar", "gz"],
+    },
+    {
+	name => "/home/bob/.bash_history - hidden file",
+	path => "/home/bob/.bash_history",
+	file_name => ".bash_history",
+	file_prefix => ".bash_history",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => [".bash_history"],
+    },
+    {
+	name => "/home/bob/..foobar - file prefixed with double dot",
+	path => "/home/bob/..foobar",
+	file_name => "..foobar",
+	file_prefix => "..foobar",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => ["..foobar"],
+    },
+    {
+	name => "/home/bob/...foo...bar...baz... - wacky but legal file name",
+	path => "/home/bob/...foo...bar...baz...",
+	file_name => "...foo...bar...baz...",
+	file_prefix => "...foo",
+	file_suffix => "",
+	file_suffixes => ["", "", "bar", "", "", "baz", "", "", ""],
+	file_parts => ["...foo", "", "", "bar", "", "", "baz", "", "", ""],
+    },
+    {
+	name => "/home/bob/...... - file name consisting solely of dots",
+	path => "/home/bob/......",
+	file_name => "......",
+	file_prefix => "......",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => ["......"],
+    },
+    {
+	name => "/home/bob/. - current path reference",
+	path => "/home/bob/.",
+	file_name => "bob",
+	file_prefix => "bob",
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => ["bob"],
+    },
+    {
+	name => "/home/bob/.. - parent path reference",
+	path => "/home/bob/..",
+	file_name => undef,
+	file_prefix => undef,
+	file_suffix => undef,
+	file_suffixes => [],
+	file_parts => [],
+    },
+];
+
+sub test_path_file_name : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_file_name: " . $case->{name};
+
+    my $file_name = eval { PVE::Path::path_file_name($case->{path}); };
+
+    if ($@) {
+	fail($name);
+	diag("Failed to get file name of path:\n$@");
+	return;
+    }
+
+    if (!is($file_name, $case->{file_name}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{file_name}));
+	diag("=== Got ===");
+	diag(explain($file_name));
+    }
+
+    return;
+}
+
+sub test_path_file_prefix : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_file_prefix: " . $case->{name};
+
+    my $file_prefix = eval { PVE::Path::path_file_prefix($case->{path}); };
+
+    if ($@) {
+	fail($name);
+	diag("Failed to get file prefix of path:\n$@");
+	return;
+    }
+
+    if (!is($file_prefix, $case->{file_prefix}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{file_prefix}));
+	diag("=== Got ===");
+	diag(explain($file_prefix));
+    }
+
+    return;
+}
+
+sub test_path_file_suffix : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_file_suffix: " . $case->{name};
+
+    my $file_suffix = eval { PVE::Path::path_file_suffix($case->{path}); };
+
+    if ($@) {
+	fail($name);
+	diag("Failed to get file suffix of path:\n$@");
+	return;
+    }
+
+    if (!is_deeply($file_suffix, $case->{file_suffix}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{file_suffix}));
+	diag("=== Got ===");
+	diag(explain($file_suffix));
+    }
+
+    return;
+}
+
+sub test_path_file_suffixes : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_file_suffixes: " . $case->{name};
+
+    my $file_suffixes = eval {
+	my @suffixes = PVE::Path::path_file_suffixes($case->{path});
+	\@suffixes;
+    };
+
+    if ($@) {
+	fail($name);
+	diag("Failed to get file suffixes of path:\n$@");
+	return;
+    }
+
+    if (!is_deeply($file_suffixes, $case->{file_suffixes}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{file_suffixes}));
+	diag("=== Got ===");
+	diag(explain($file_suffixes));
+    }
+
+    return;
+}
+
+sub test_path_file_parts : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_file_parts: " . $case->{name};
+
+    my $file_parts = eval {
+	my @parts = PVE::Path::path_file_parts($case->{path});
+	\@parts;
+    };
+
+    if ($@) {
+	fail($name);
+	diag("Failed to get file parts of path:\n$@");
+	return;
+    }
+
+    if (!is_deeply($file_parts, $case->{file_parts}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{file_parts}));
+	diag("=== Got ===");
+	diag(explain($file_parts));
+    }
+
+    return;
+}
+
+my $path_with_file_name_cases = [
+    {
+	name => "no path, no file name",
+	path => "",
+	file_name => "",
+	expected => "",
+    },
+    {
+	name => "root, no file name",
+	path => "/",
+	file_name => "",
+	expected => "/",
+    },
+    {
+	name => "no path, file name",
+	path => "",
+	file_name => "foo",
+	expected => "foo",
+    },
+    {
+	name => "root, file name",
+	path => "/",
+	file_name => "foo",
+	expected => "/foo",
+    },
+    {
+	name => "single path component, no file name",
+	path => "foo",
+	file_name => "",
+	expected => "",
+    },
+    {
+	name => "single path component, absolute, no file name",
+	path => "/foo",
+	file_name => "",
+	expected => "/",
+    },
+    {
+	name => "single path component, file name",
+	path => "foo",
+	file_name => "bar",
+	expected => "bar",
+    },
+    {
+	name => "single path component, absolute, file name",
+	path => "/foo",
+	file_name => "bar",
+	expected => "/bar",
+    },
+    {
+	name => "multiple path components, no file name",
+	path => "foo/bar/baz",
+	file_name => "",
+	expected => "foo/bar",
+    },
+    {
+	name => "multiple path components, absolute, no file name",
+	path => "/foo/bar/baz",
+	file_name => "",
+	expected => "/foo/bar",
+    },
+    {
+	name => "multiple path components, file name",
+	path => "foo/bar/baz",
+	file_name => "qux",
+	expected => "foo/bar/qux",
+    },
+    {
+	name => "multiple path components, absolute, file name",
+	path => "/foo/bar/baz",
+	file_name => "qux",
+	expected => "/foo/bar/qux",
+    },
+    {
+	name => "multiple path components with current path reference, no file name",
+	path => "foo/bar/baz/.",
+	file_name => "",
+	expected => "foo/bar",
+    },
+    {
+	name => "multiple path components with current path reference, file name",
+	path => "foo/bar/baz/.",
+	file_name => "qux",
+	expected => "foo/bar/qux",
+    },
+    {
+	name => "multiple path components with parent path reference, no file name",
+	path => "foo/bar/baz/..",
+	file_name => "",
+	expected => "foo/bar/baz",
+    },
+    {
+	name => "multiple path components with parent path reference, file name",
+	path => "foo/bar/baz/..",
+	file_name => "qux",
+	expected => "foo/bar/baz/qux",
+    },
+    {
+	name => "/home/bob/foo.txt --> /home/bob/bar.txt",
+	path => "/home/bob/foo.txt",
+	file_name => "bar.txt",
+	expected => "/home/bob/bar.txt",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/backup.tar.zst",
+	path => "/tmp/archive.tar.gz",
+	file_name => "backup.tar.zst",
+	expected => "/tmp/backup.tar.zst",
+    },
+    {
+	name => "/home/bob/...foo.txt --> /home/bob/...bar.csv",
+	path => "/home/bob/...foo.txt",
+	file_name => "...bar.csv",
+	expected => "/home/bob/...bar.csv",
+    },
+    {
+	name => "file name with path separator",
+	path => "foo/bar/baz",
+	file_name => "quo/qux",
+	expected => undef,
+	should_throw => 1,
+    },
+];
+
+sub test_path_with_file_name : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_with_file_name: " . $case->{name};
+
+    my $new_path = eval {
+	PVE::Path::path_with_file_name($case->{path}, $case->{file_name});
+    };
+
+    if ($@) {
+	if ($case->{should_throw}) {
+	    pass($name);
+	    return;
+	}
+
+	fail($name);
+	diag("Failed to replace file name of path:\n$@");
+	return;
+    }
+
+    if (!is($new_path, $case->{expected}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{expected}));
+	diag("=== Got ===");
+	diag(explain($new_path));
+    }
+
+    return;
+}
+
+my $path_with_file_prefix_cases = [
+    {
+	name => "no path, no prefix",
+	path => "",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "root, no prefix",
+	path => "/",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "no path, prefix",
+	path => "",
+	prefix => "foo",
+	expected => undef,
+    },
+    {
+	name => "root, prefix",
+	path => "/",
+	prefix => "foo",
+	expected => undef,
+    },
+    {
+	name => "single path component, no prefix",
+	path => "foo",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "single path component, absolute, no prefix",
+	path => "/foo",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "single path component, prefix",
+	path => "foo",
+	prefix => "bar",
+	expected => "bar",
+    },
+    {
+	name => "single path component, absolute, prefix",
+	path => "/foo",
+	prefix => "bar",
+	expected => "/bar",
+    },
+    {
+	name => "multiple path components, no prefix",
+	path => "foo/bar/baz",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "multiple path components, absolute, no prefix",
+	path => "/foo/bar/baz",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "multiple path components, prefix",
+	path => "foo/bar/baz",
+	prefix => "qux",
+	expected => "foo/bar/qux",
+    },
+    {
+	name => "multiple path components, absolute, prefix",
+	path => "/foo/bar/baz",
+	prefix => "qux",
+	expected => "/foo/bar/qux",
+    },
+    {
+	name => "multiple path components with current path reference, no prefix",
+	path => "foo/bar/baz/.",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "multiple path components with current path reference, prefix",
+	path => "foo/bar/baz/.",
+	prefix => "qux",
+	expected => "foo/bar/qux",
+    },
+    {
+	name => "multiple path components with parent path reference, no prefix",
+	path => "foo/bar/baz/..",
+	prefix => "",
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent path reference, prefix",
+	path => "foo/bar/baz/..",
+	prefix => "qux",
+	expected => undef,
+    },
+    {
+	name => "/home/bob/foo.txt --> /home/bob/bar.txt",
+	path => "/home/bob/foo.txt",
+	prefix => "bar",
+	expected => "/home/bob/bar.txt",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/backup.tar.gz",
+	path => "/tmp/archive.tar.gz",
+	prefix => "backup",
+	expected => "/tmp/backup.tar.gz",
+    },
+    {
+	name => "/home/bob/...foo.txt --> /home/bob/...bar.txt",
+	path => "/home/bob/...foo.txt",
+	prefix => "...bar",
+	expected => "/home/bob/...bar.txt",
+    },
+    {
+	name => "prefix with path separator",
+	path => "foo/bar/baz",
+	prefix => "quo/qux",
+	expected => undef,
+	should_throw => 1,
+    },
+    {
+	name => "prefix ends with dot",
+	path => "foo/bar/baz",
+	prefix => "quo.",
+	expected => undef,
+	should_throw => 1,
+    },
+];
+
+sub test_path_with_file_prefix : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_with_file_prefix: " . $case->{name};
+
+    my $new_path = eval {
+	PVE::Path::path_with_file_prefix($case->{path}, $case->{prefix});
+    };
+
+    if ($@) {
+	if ($case->{should_throw}) {
+	    pass($name);
+	    return;
+	}
+
+	fail($name);
+	diag("Failed to replace file prefix of path:\n$@");
+	return;
+    }
+
+    if (!is($new_path, $case->{expected}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{expected}));
+	diag("=== Got ===");
+	diag(explain($new_path));
+    }
+
+    return;
+}
+
+my $path_with_file_suffix_cases = [
+    {
+	name => "no path, empty suffix",
+	path => "",
+	suffix => undef,
+	expected => undef,
+    },
+    {
+	name => "root, empty suffix",
+	path => "/",
+	suffix => undef,
+	expected => undef,
+    },
+    {
+	name => "no path, suffix",
+	path => "",
+	suffix => "foo",
+	expected => undef,
+    },
+    {
+	name => "root, suffix",
+	path => "/",
+	suffix => "foo",
+	expected => undef,
+    },
+    {
+	name => "no path, undef suffix",
+	path => "",
+	suffix => undef,
+	expected => undef,
+    },
+    {
+	name => "root, undef suffix",
+	path => "/",
+	suffix => undef,
+	expected => undef,
+    },
+    {
+	name => "single path component, empty suffix",
+	path => "foo",
+	suffix => "",
+	expected => "foo.",
+    },
+    {
+	name => "single path component, absolute, empty suffix",
+	path => "/foo",
+	suffix => "",
+	expected => "/foo.",
+    },
+    {
+	name => "single path component, suffix",
+	path => "foo",
+	suffix => "bar",
+	expected => "foo.bar",
+    },
+    {
+	name => "single path component, absolute, suffix",
+	path => "/foo",
+	suffix => "bar",
+	expected => "/foo.bar",
+    },
+    {
+	name => "single path component, undef suffix",
+	path => "foo",
+	suffix => undef,
+	expected => "foo",
+    },
+    {
+	name => "single path component, absolute, undef suffix",
+	path => "/foo",
+	suffix => undef,
+	expected => "/foo",
+    },
+    {
+	name => "multiple path components, empty suffix",
+	path => "foo/bar/baz",
+	suffix => "",
+	expected => "foo/bar/baz.",
+    },
+    {
+	name => "multiple path components, absolute, empty suffix",
+	path => "/foo/bar/baz",
+	suffix => "",
+	expected => "/foo/bar/baz.",
+    },
+    {
+	name => "multiple path components, suffix",
+	path => "foo/bar/baz",
+	suffix => "qux",
+	expected => "foo/bar/baz.qux",
+    },
+    {
+	name => "multiple path components, absolute, suffix",
+	path => "/foo/bar/baz",
+	suffix => "qux",
+	expected => "/foo/bar/baz.qux",
+    },
+    {
+	name => "multiple path components, undef suffix",
+	path => "foo/bar/baz",
+	suffix => undef,
+	expected => "foo/bar/baz",
+    },
+    {
+	name => "multiple path components, absolute, undef suffix",
+	path => "/foo/bar/baz",
+	suffix => undef,
+	expected => "/foo/bar/baz",
+    },
+    {
+	name => "multiple path components with current path reference, empty suffix",
+	path => "foo/bar/baz/.",
+	suffix => "",
+	expected => "foo/bar/baz.",
+    },
+    {
+	name => "multiple path components with current path reference, suffix",
+	path => "foo/bar/baz/.",
+	suffix => "qux",
+	expected => "foo/bar/baz.qux",
+    },
+    {
+	name => "multiple path components with current path reference, undef suffix",
+	path => "foo/bar/baz/.",
+	suffix => undef,
+	expected => "foo/bar/baz/.",
+    },
+    {
+	name => "multiple path components with parent path reference, empty suffix",
+	path => "foo/bar/baz/..",
+	suffix => "",
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent path reference, suffix",
+	path => "foo/bar/baz/..",
+	suffix => "qux",
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent path reference, undef suffix",
+	path => "foo/bar/baz/..",
+	suffix => "qux",
+	expected => undef,
+    },
+    {
+	name => "/home/bob/foo.txt --> /home/bob/foo.mp4",
+	path => "/home/bob/foo.txt",
+	suffix => "mp4",
+	expected => "/home/bob/foo.mp4",
+    },
+    {
+	name => "/home/bob/foo.txt --> /home/bob/foo.",
+	path => "/home/bob/foo.txt",
+	suffix => "",
+	expected => "/home/bob/foo.",
+    },
+    {
+	name => "/home/bob/foo.txt --> /home/bob/foo",
+	path => "/home/bob/foo",
+	suffix => undef,
+	expected => "/home/bob/foo",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar.zst",
+	path => "/tmp/archive.tar.gz",
+	suffix => "zst",
+	expected => "/tmp/archive.tar.zst",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar.",
+	path => "/tmp/archive.tar.",
+	suffix => "",
+	expected => "/tmp/archive.tar.",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar",
+	path => "/tmp/archive.tar.gz",
+	suffix => undef,
+	expected => "/tmp/archive.tar",
+    },
+    {
+	name => "/home/bob/...foo.txt --> /home/bob/...foo.csv",
+	path => "/home/bob/...foo.txt",
+	suffix => "csv",
+	expected => "/home/bob/...foo.csv",
+    },
+    {
+	name => "/home/bob/...foo.txt --> /home/bob/...foo.",
+	path => "/home/bob/...foo.txt",
+	suffix => "",
+	expected => "/home/bob/...foo.",
+    },
+    {
+	name => "/home/bob/...foo.txt --> /home/bob/...foo",
+	path => "/home/bob/...foo.txt",
+	suffix => undef,
+	expected => "/home/bob/...foo",
+    },
+    {
+	name => "/home/bob/...foo --> /home/bob/...foo.txt",
+	path => "/home/bob/...foo",
+	suffix => "txt",
+	expected => "/home/bob/...foo.txt",
+    },
+    {
+	name => "/home/bob/...foo --> /home/bob/...foo.",
+	path => "/home/bob/...foo",
+	suffix => "",
+	expected => "/home/bob/...foo.",
+    },
+    {
+	name => "/home/bob/...foo --> /home/bob/...foo",
+	path => "/home/bob/...foo",
+	suffix => undef,
+	expected => "/home/bob/...foo",
+    },
+    {
+	name => "/home/bob/...foo. --> /home/bob/...foo.",
+	path => "/home/bob/...foo.",
+	suffix => "",
+	expected => "/home/bob/...foo.",
+    },
+    {
+	name => "/home/bob/...foo. --> /home/bob/...foo.txt",
+	path => "/home/bob/...foo.",
+	suffix => "txt",
+	expected => "/home/bob/...foo.txt",
+    },
+    {
+	name => "/home/bob/...foo. --> /home/bob/...foo",
+	path => "/home/bob/...foo.",
+	suffix => undef,
+	expected => "/home/bob/...foo",
+    },
+    {
+	name => "suffix with path separator",
+	path => "foo/bar/baz",
+	suffix => "quo/qux",
+	expected => undef,
+	should_throw => 1,
+    },
+    {
+	name => "suffix contains dot",
+	path => "foo/bar/baz",
+	suffix => "quo.qux",
+	expected => undef,
+	should_throw => 1,
+    },
+];
+
+sub test_path_with_file_suffix : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_with_file_suffix: " . $case->{name};
+
+    my $new_path = eval {
+	PVE::Path::path_with_file_suffix($case->{path}, $case->{suffix});
+    };
+
+    if ($@) {
+	if ($case->{should_throw}) {
+	    pass($name);
+	    return;
+	}
+
+	fail($name);
+	diag("Failed to replace file suffix of path:\n$@");
+	return;
+    }
+
+    if (!is($new_path, $case->{expected}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{expected}));
+	diag("=== Got ===");
+	diag(explain($new_path));
+    }
+
+    return;
+}
+
+my $path_with_file_suffixes_cases = [
+    {
+	name => "no path, no suffixes",
+	path => "",
+	suffixes => [],
+	expected => undef,
+    },
+    {
+	name => "root, no suffixes",
+	path => "/",
+	suffixes => [],
+	expected => undef,
+    },
+    {
+	name => "no path, suffixes (1)",
+	path => "",
+	suffixes => ["tar"],
+	expected => undef,
+    },
+    {
+	name => "root, suffixes (1)",
+	path => "/",
+	suffixes => ["tar"],
+	expected => undef,
+    },
+    {
+	name => "single path component, no suffixes",
+	path => "foo",
+	suffixes => [],
+	expected => "foo",
+    },
+    {
+	name => "single path component, absolute, no suffixes",
+	path => "/foo",
+	suffixes => [],
+	expected => "/foo",
+    },
+    {
+	name => "single path component, suffixes (1)",
+	path => "foo",
+	suffixes => ["tar"],
+	expected => "foo.tar",
+    },
+    {
+	name => "single path component, absolute, suffixes (1)",
+	path => "/foo",
+	suffixes => ["tar"],
+	expected => "/foo.tar",
+    },
+    {
+	name => "single path component, suffixes (3)",
+	path => "foo",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "foo.tar.zst.bak",
+    },
+    {
+	name => "single path component, absolute, suffixes (3)",
+	path => "/foo",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "/foo.tar.zst.bak",
+    },
+    {
+	name => "single path component, suffixes (10)",
+	path => "foo",
+	suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+	expected => "foo.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+    },
+    {
+	name => "single path component, absolute, suffixes (10)",
+	path => "/foo",
+	suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+	expected => "/foo.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+    },
+    {
+	name => "multiple path components, no suffixes",
+	path => "foo/bar/baz",
+	suffixes => [],
+	expected => "foo/bar/baz",
+    },
+    {
+	name => "multiple path components, absolute, no suffixes",
+	path => "/foo/bar/baz",
+	suffixes => [],
+	expected => "/foo/bar/baz",
+    },
+    {
+	name => "multiple path components, suffixes (1)",
+	path => "foo/bar/baz",
+	suffixes => ["tar"],
+	expected => "foo/bar/baz.tar",
+    },
+    {
+	name => "multiple path components, absolute, suffixes (1)",
+	path => "/foo/bar/baz",
+	suffixes => ["tar"],
+	expected => "/foo/bar/baz.tar",
+    },
+    {
+	name => "multiple path components, suffixes (3)",
+	path => "foo/bar/baz",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "foo/bar/baz.tar.zst.bak",
+    },
+    {
+	name => "multiple path components, absolute, suffixes (3)",
+	path => "/foo/bar/baz",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "/foo/bar/baz.tar.zst.bak",
+    },
+    {
+	name => "multiple path components, suffixes (10)",
+	path => "foo/bar/baz",
+	suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+	expected => "foo/bar/baz.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+    },
+    {
+	name => "multiple path components, absolute, suffixes (10)",
+	path => "/foo/bar/baz",
+	suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+	expected => "/foo/bar/baz.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+    },
+    {
+	name => "multiple path components with current path reference, no suffixes",
+	path => "foo/bar/baz/.",
+	suffixes => [],
+	expected => "foo/bar/baz/.",
+    },
+    {
+	name => "multiple path components with current path reference, absolute, no suffixes",
+	path => "/foo/bar/baz/.",
+	suffixes => [],
+	expected => "/foo/bar/baz/.",
+    },
+    {
+	name => "multiple path components with current path reference, suffixes (3)",
+	path => "foo/bar/baz/.",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "foo/bar/baz.tar.zst.bak",
+    },
+    {
+	name => "multiple path components with current path reference, absolute, suffixes (3)",
+	path => "/foo/bar/baz/.",
+	suffixes => ["tar", "zst", "bak"],
+	expected => "/foo/bar/baz.tar.zst.bak",
+    },
+    {
+	name => "multiple path components with parent directory reference, no suffixes",
+	path => "foo/bar/baz/..",
+	suffixes => [],
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent directory reference, absolute, no suffixes",
+	path => "/foo/bar/baz/..",
+	suffixes => [],
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent directory reference, suffixes (3)",
+	path => "foo/bar/baz/..",
+	suffixes => ["tar", "zst", "bak"],
+	expected => undef,
+    },
+    {
+	name => "multiple path components with parent directory reference, absolute, suffixes (3)",
+	path => "/foo/bar/baz/..",
+	suffixes => ["tar", "zst", "bak"],
+	expected => undef,
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar.zst",
+	path => "/tmp/archive.tar.gz",
+	suffixes => ["tar", "zst"],
+	expected => "/tmp/archive.tar.zst",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar",
+	path => "/tmp/archive.tar.gz",
+	suffixes => ["tar"],
+	expected => "/tmp/archive.tar",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive.tar.",
+	path => "/tmp/archive.tar.gz",
+	suffixes => ["tar", ""],
+	expected => "/tmp/archive.tar.",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive..",
+	path => "/tmp/archive.tar.gz",
+	suffixes => ["", ""],
+	expected => "/tmp/archive..",
+    },
+    {
+	name => "/tmp/archive.tar --> /tmp/archive.tar.gz",
+	path => "/tmp/archive.tar",
+	suffixes => ["tar", "gz"],
+	expected => "/tmp/archive.tar.gz",
+    },
+    {
+	name => "/tmp/archive --> /tmp/archive.tar.gz",
+	path => "/tmp/archive",
+	suffixes => ["tar", "gz"],
+	expected => "/tmp/archive.tar.gz",
+    },
+    {
+	name => "/tmp/archive.tar.gz --> /tmp/archive",
+	path => "/tmp/archive.tar.gz",
+	suffixes => [],
+	expected => "/tmp/archive",
+    },
+    {
+	name => "/tmp/archive --> /tmp/archive",
+	path => "/tmp/archive",
+	suffixes => [],
+	expected => "/tmp/archive",
+    },
+    {
+	name => "/home/bob/...one...two...three --> /home/bob/...one...foo...bar",
+	path => "/home/bob/...one...two...three",
+	suffixes => ["", "", "foo", "", "", "bar"],
+	expected => "/home/bob/...one...foo...bar",
+    },
+    {
+	name => "suffixes contain a path separator",
+	path => "foo/bar/baz",
+	suffixes => ["tar", "oh/no", "zst"],
+	expected => undef,
+	should_throw => 1,
+    },
+    {
+	name => "suffixes contain a dot",
+	path => "foo/bar/baz",
+	suffixes => ["tar", "oh.no", "zst"],
+	expected => undef,
+	should_throw => 1,
+    },
+    {
+	name => "suffixes contain undef",
+	path => "foo/bar/baz",
+	suffixes => ["tar", undef, "zst"],
+	expected => undef,
+	should_throw => 1,
+    },
+];
+
+sub test_path_with_file_suffixes : prototype($) {
+    my ($case) = @_;
+
+    my $name = "path_with_file_suffixes: " . $case->{name};
+
+    my $new_path = eval {
+	PVE::Path::path_with_file_suffixes($case->{path}, $case->{suffixes}->@*);
+    };
+
+    if ($@) {
+	if ($case->{should_throw}) {
+	    pass($name);
+	    return;
+	}
+
+	fail($name);
+	diag("Failed to replace file suffixes of path:\n$@");
+	return;
+    }
+
+    if (!is($new_path, $case->{expected}, $name)) {
+	diag("=== Expected ===");
+	diag(explain($case->{expected}));
+	diag("=== Got ===");
+	diag(explain($new_path));
+    }
+
+    return;
+}
+
+sub main : prototype() {
+    my $file_part_test_subs = [
+	\&test_path_file_name,
+	\&test_path_file_prefix,
+	\&test_path_file_suffix,
+	\&test_path_file_suffixes,
+	\&test_path_file_parts,
+    ];
+
+    plan(
+	tests => scalar($path_file_part_cases->@*) * scalar($file_part_test_subs->@*)
+	    + scalar($path_with_file_name_cases->@*)
+	    + scalar($path_with_file_prefix_cases->@*)
+	    + scalar($path_with_file_suffix_cases->@*)
+	    + scalar($path_with_file_suffixes_cases->@*)
+    );
+
+    for my $case ($path_file_part_cases->@*) {
+	for my $test_sub ($file_part_test_subs->@*) {
+	    eval {
+		# suppress warnings here to make output less noisy for certain tests if necessary
+		# local $SIG{__WARN__} = sub {};
+		$test_sub->($case);
+	    };
+	    warn "$@\n" if $@;
+	}
+    }
+
+    for my $case ($path_with_file_name_cases->@*) {
+	eval {
+	    # local $SIG{__WARN__} = sub {};
+	    test_path_with_file_name($case);
+	};
+	warn "$@\n" if $@;
+    }
+
+    for my $case ($path_with_file_prefix_cases->@*) {
+	eval {
+	    # local $SIG{__WARN__} = sub {};
+	    test_path_with_file_prefix($case);
+	};
+	warn "$@\n" if $@;
+    }
+
+    for my $case ($path_with_file_suffix_cases->@*) {
+	eval {
+	    # local $SIG{__WARN__} = sub {};
+	    test_path_with_file_suffix($case);
+	};
+	warn "$@\n" if $@;
+    }
+
+    for my $case ($path_with_file_suffixes_cases->@*) {
+	eval {
+	    # local $SIG{__WARN__} = sub {};
+	    test_path_with_file_suffixes($case);
+	};
+	warn "$@\n" if $@;
+    }
+
+    done_testing();
+
+    return;
+}
+
+main();
-- 
2.39.5



_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel