[pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path
Max Carrara
m.carrara at proxmox.com
Thu Dec 19 19:31:41 CET 2024
This commit adds a plethora of parameterized tests for all functions
of PVE::Path (except aliases). This surmounts to 1050 tests being run
in total. Some of these tests might perhaps be redundant, but the goal
here was to be better safe than sorry and really make sure that
nothing slips through.
Signed-off-by: Max Carrara <m.carrara at proxmox.com>
---
test/Makefile | 5 +-
test/Path/Makefile | 20 +
test/Path/path_basic_tests.pl | 1331 ++++++++++++++++++++++++++++
test/Path/path_comparison_tests.pl | 859 ++++++++++++++++++
test/Path/path_file_ops_tests.pl | 1220 +++++++++++++++++++++++++
test/Path/path_join_tests.pl | 310 +++++++
test/Path/path_push_tests.pl | 159 ++++
7 files changed, 3903 insertions(+), 1 deletion(-)
create mode 100644 test/Path/Makefile
create mode 100755 test/Path/path_basic_tests.pl
create mode 100755 test/Path/path_comparison_tests.pl
create mode 100755 test/Path/path_file_ops_tests.pl
create mode 100755 test/Path/path_join_tests.pl
create mode 100755 test/Path/path_push_tests.pl
diff --git a/test/Makefile b/test/Makefile
index 4e25a46..5c8f157 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -1,4 +1,7 @@
-SUBDIRS = etc_network_interfaces
+SUBDIRS = etc_network_interfaces \
+ Path \
+
+
TESTS = lock_file.test \
calendar_event_test.test \
convert_size_test.test \
diff --git a/test/Path/Makefile b/test/Path/Makefile
new file mode 100644
index 0000000..75aa020
--- /dev/null
+++ b/test/Path/Makefile
@@ -0,0 +1,20 @@
+TESTS = path_basic_tests.pl \
+ path_comparison_tests.pl \
+ path_file_ops_tests.pl \
+ path_join_tests.pl \
+ path_push_tests.pl \
+
+
+TEST_TARGETS = $(addsuffix .t,$(basename ${TESTS}))
+
+all:
+
+.PHONY: check
+
+check: ${TEST_TARGETS}
+
+%.t: %.pl
+ ./$<
+
+distclean: clean
+clean:
diff --git a/test/Path/path_basic_tests.pl b/test/Path/path_basic_tests.pl
new file mode 100755
index 0000000..80a3104
--- /dev/null
+++ b/test/Path/path_basic_tests.pl
@@ -0,0 +1,1331 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $cases = [
+ {
+ name => "empty string",
+ path => "",
+ components => [],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "",
+ parent => undef,
+ },
+ {
+ name => "single component, relative",
+ path => "foo",
+ components => ["foo"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo",
+ parent => "",
+ },
+ {
+ name => "single component, absolute",
+ path => "/foo",
+ components => ["/", "foo"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo",
+ parent => "/",
+ },
+ {
+ name => "two components, relative",
+ path => "foo/bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, absolute",
+ path => "/foo/bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, trailing slashes (1), relative",
+ path => "foo/bar/",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, trailing slashes (1), absolute",
+ path => "/foo/bar/",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, trailing slashes (2), relative",
+ path => "foo/bar//",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, trailing slashes (2), absolute",
+ path => "/foo/bar//",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, trailing slashes (3), relative",
+ path => "foo/bar///",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, trailing slashes (3), absolute",
+ path => "/foo/bar///",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, trailing slashes (10), relative",
+ path => "foo/bar//////////",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, trailing slashes (10), absolute",
+ path => "/foo/bar//////////",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, repeated separators (2), relative",
+ path => "foo//bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, repeated separators (2), absolute",
+ path => "/foo//bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, repeated root (2)",
+ path => "//foo/bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "//foo",
+ },
+ {
+ name => "two components, repeated separators (2), repeated root (2)",
+ path => "//foo//bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "//foo",
+ },
+ {
+ name => "two components, repeated separators (3), relative",
+ path => "foo///bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, repeated separators (3), absolute",
+ path => "/foo///bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, repeated root (3)",
+ path => "///foo/bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "///foo",
+ },
+ {
+ name => "two components, repeated separators (3), repeated root (3)",
+ path => "///foo///bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "///foo",
+ },
+ {
+ name => "two components, repeated separators (10), relative",
+ path => "foo////////////bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, repeated separators (10), absolute",
+ path => "/foo////////////bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "/foo",
+ },
+ {
+ name => "two components, repeated root (10)",
+ path => "//////////foo/bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "//////////foo",
+ },
+ {
+ name => "two components, repeated separators (10), repeated root (10)",
+ path => "//////////foo//////////bar",
+ components => ["/", "foo", "bar"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar",
+ parent => "//////////foo",
+ },
+ {
+ name => "three components, relative",
+ path => "foo/bar/baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, absolute",
+ path => "/foo/bar/baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (1), relative",
+ path => "foo/bar/baz/",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (1), absolute",
+ path => "/foo/bar/baz/",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (2), relative",
+ path => "foo/bar/baz//",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (2), absolute",
+ path => "/foo/bar/baz//",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (3), relative",
+ path => "foo/bar/baz///",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (3), absolute",
+ path => "/foo/bar/baz///",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (10), relative",
+ path => "foo/bar/baz//////////",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, trailing slashes (10), absolute",
+ path => "/foo/bar/baz//////////",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo/bar",
+ },
+ {
+ name => "three components, repeated separators (2), relative",
+ path => "foo//bar//baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo//bar",
+ },
+ {
+ name => "three components, repeated separators (2), absolute",
+ path => "/foo//bar//baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo//bar",
+ },
+ {
+ name => "three components, repeated root (2)",
+ path => "//foo/bar/baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "//foo/bar",
+ },
+ {
+ name => "three components, repeated separators (2), repeated root (2)",
+ path => "//foo//bar//baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "//foo//bar",
+ },
+ {
+ name => "three components, repeated separators (3), relative",
+ path => "foo///bar///baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo///bar",
+ },
+ {
+ name => "three components, repeated separators (3), absolute",
+ path => "/foo///bar///baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo///bar",
+ },
+ {
+ name => "three components, repeated root (3)",
+ path => "///foo/bar/baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "///foo/bar",
+ },
+ {
+ name => "three components, repeated separators (3), repeated root (3)",
+ path => "///foo///bar///baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "///foo///bar",
+ },
+ {
+ name => "three components, repeated separators (10), relative",
+ path => "foo////////////bar//////////baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo////////////bar",
+ },
+ {
+ name => "three components, repeated separators (10), absolute",
+ path => "/foo////////////bar//////////baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "/foo////////////bar",
+ },
+ {
+ name => "three components, repeated root (10)",
+ path => "//////////foo/bar/baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "//////////foo/bar",
+ },
+ {
+ name => "three components, repeated separators (10), repeated root (10)",
+ path => "//////////foo//////////bar//////////baz",
+ components => ["/", "foo", "bar", "baz"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/foo/bar/baz",
+ parent => "//////////foo//////////bar",
+ },
+ # # # Current directory references
+ {
+ name => "two components, current directory reference (1, start)",
+ path => "./foo/bar",
+ components => [".", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "./foo",
+ },
+ {
+ name => "two components, current directory reference (1, middle)",
+ path => "foo/./bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (1, end)",
+ path => "foo/bar/.",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (2, start)",
+ path => "././foo/bar",
+ components => [".", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "././foo",
+ },
+ {
+ name => "two components, current directory reference (2, middle)",
+ path => "foo/././bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (2, end)",
+ path => "foo/bar/./.",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (3, start)",
+ path => "./././foo/bar",
+ components => [".", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "./././foo",
+ },
+ {
+ name => "two components, current directory reference (3, middle)",
+ path => "foo/./././bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (3, end)",
+ path => "foo/bar/././.",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (10, start)",
+ path => "././././././././././foo/bar",
+ components => [".", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "././././././././././foo",
+ },
+ {
+ name => "two components, current directory reference (10, middle)",
+ path => "foo/././././././././././bar",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "two components, current directory reference (10, end)",
+ path => "foo/bar/./././././././././.",
+ components => ["foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar",
+ parent => "foo",
+ },
+ {
+ name => "three components, current directory reference (1, start)",
+ path => "./foo/bar/baz",
+ components => [".", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "./foo/bar",
+ },
+ {
+ name => "three components, current directory reference (1, middle)",
+ path => "foo/./bar/./baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/./bar",
+ },
+ {
+ name => "three components, current directory reference (1, end)",
+ path => "foo/bar/baz/.",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (2, start)",
+ path => "././foo/bar/baz",
+ components => [".", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "././foo/bar",
+ },
+ {
+ name => "three components, current directory reference (2, middle)",
+ path => "foo/././bar/././baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/././bar",
+ },
+ {
+ name => "three components, current directory reference (2, end)",
+ path => "foo/bar/baz/./.",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (3, start)",
+ path => "./././foo/bar/baz",
+ components => [".", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "./././foo/bar",
+ },
+ {
+ name => "three components, current directory reference (3, middle)",
+ path => "foo/./././bar/./././baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/./././bar",
+ },
+ {
+ name => "three components, current directory reference (3, end)",
+ path => "foo/bar/baz/././.",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (10, start)",
+ path => "././././././././././foo/bar/baz",
+ components => [".", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "././././././././././foo/bar",
+ },
+ {
+ name => "three components, current directory reference (10, middle)",
+ path => "foo/././././././././././bar/././././././././././baz",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/././././././././././bar",
+ },
+ {
+ name => "three components, current directory reference (10, end)",
+ path => "foo/bar/baz/./././././././././.",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (1, end), trailing slashes (1)",
+ path => "foo/bar/baz/./",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (2, end), trailing slashes (1)",
+ path => "foo/bar/baz/././",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (1, end), trailing slashes (2)",
+ path => "foo/bar/baz/.//",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (2, end), trailing slashes (2)",
+ path => "foo/bar/baz/././/",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (3, end), trailing slashes (1)",
+ path => "foo/bar/baz/./././",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (1, end), trailing slashes (3)",
+ path => "foo/bar/baz/.///",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ {
+ name => "three components, current directory reference (3, end), trailing slashes (3)",
+ path => "foo/bar/baz/./././//",
+ components => ["foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz",
+ parent => "foo/bar",
+ },
+ # # # Parent directory references
+ {
+ name => "two components, parent directory reference (1, start)",
+ path => "../foo/bar",
+ components => ["..", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../foo/bar",
+ parent => "../foo",
+ },
+ {
+ name => "two components, parent directory reference (1, middle)",
+ path => "foo/../bar",
+ components => ["foo", "..", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../bar",
+ parent => "foo/..",
+ },
+ {
+ name => "two components, parent directory reference (1, end)",
+ path => "foo/bar/..",
+ components => ["foo", "bar", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/..",
+ parent => "foo/bar",
+ },
+ {
+ name => "two components, parent directory reference (2, start)",
+ path => "../../foo/bar",
+ components => ["..", "..", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../foo/bar",
+ parent => "../../foo",
+ },
+ {
+ name => "two components, parent directory reference (2, middle)",
+ path => "foo/../../bar",
+ components => ["foo", "..", "..", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../bar",
+ parent => "foo/../..",
+ },
+ {
+ name => "two components, parent directory reference (2, end)",
+ path => "foo/bar/../..",
+ components => ["foo", "bar", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/../..",
+ parent => "foo/bar/..",
+ },
+ {
+ name => "two components, parent directory reference (3, start)",
+ path => "../../../foo/bar",
+ components => ["..", "..", "..", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../../foo/bar",
+ parent => "../../../foo",
+ },
+ {
+ name => "two components, parent directory reference (3, middle)",
+ path => "foo/../../../bar",
+ components => ["foo", "..", "..", "..", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../../bar",
+ parent => "foo/../../..",
+ },
+ {
+ name => "two components, parent directory reference (3, end)",
+ path => "foo/bar/../../..",
+ components => ["foo", "bar", "..", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/../../..",
+ parent => "foo/bar/../..",
+ },
+ {
+ name => "two components, parent directory reference (10, start)",
+ path => "../../../../../../../../../../foo/bar",
+ components => ["..", "..", "..", "..", "..", "..", "..", "..", "..", "..", "foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../../../../../../../../../foo/bar",
+ parent => "../../../../../../../../../../foo",
+ },
+ {
+ name => "two components, parent directory reference (10, middle)",
+ path => "foo/../../../../../../../../../../bar",
+ components => ["foo", "..", "..", "..", "..", "..", "..", "..", "..", "..", "..", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../../../../../../../../../bar",
+ parent => "foo/../../../../../../../../../..",
+ },
+ {
+ name => "two components, parent directory reference (10, end)",
+ path => "foo/bar/../../../../../../../../../..",
+ components => ["foo", "bar", "..", "..", "..", "..", "..", "..", "..", "..", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/../../../../../../../../../..",
+ parent => "foo/bar/../../../../../../../../..",
+ },
+ {
+ name => "three components, parent directory reference (1, start)",
+ path => "../foo/bar/baz",
+ components => ["..", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../foo/bar/baz",
+ parent => "../foo/bar",
+ },
+ {
+ name => "three components, parent directory reference (1, middle)",
+ path => "foo/../bar/../baz",
+ components => ["foo", "..", "bar", "..", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../bar/../baz",
+ parent => "foo/../bar/..",
+ },
+ {
+ name => "three components, parent directory reference (1, end)",
+ path => "foo/bar/baz/..",
+ components => ["foo", "bar", "baz", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/..",
+ parent => "foo/bar/baz",
+ },
+ {
+ name => "three components, parent directory reference (2, start)",
+ path => "../../foo/bar/baz",
+ components => ["..", "..", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../foo/bar/baz",
+ parent => "../../foo/bar",
+ },
+ {
+ name => "three components, parent directory reference (2, middle)",
+ path => "foo/../../bar/../../baz",
+ components => ["foo", "..", "..","bar", "..", "..", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../bar/../../baz",
+ parent => "foo/../../bar/../..",
+ },
+ {
+ name => "three components, parent directory reference (2, end)",
+ path => "foo/bar/baz/../..",
+ components => ["foo", "bar", "baz", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../..",
+ parent => "foo/bar/baz/..",
+ },
+ {
+ name => "three components, parent directory reference (3, start)",
+ path => "../../../foo/bar/baz",
+ components => ["..", "..", "..", "foo", "bar", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../../foo/bar/baz",
+ parent => "../../../foo/bar",
+ },
+ {
+ name => "three components, parent directory reference (3, middle)",
+ path => "foo/../../../bar/../../../baz",
+ components => ["foo", "..", "..", "..", "bar", "..", "..", "..", "baz"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../../bar/../../../baz",
+ parent => "foo/../../../bar/../../..",
+ },
+ {
+ name => "three components, parent directory reference (3, end)",
+ path => "foo/bar/baz/../../..",
+ components => ["foo", "bar", "baz", "..", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../../..",
+ parent => "foo/bar/baz/../..",
+ },
+ {
+ name => "three components, parent directory reference (10, start)",
+ path => "../../../../../../../../../../foo/bar/baz",
+ components => [
+ "..", "..", "..", "..", "..", "..", "..", "..", "..", "..", "foo", "bar", "baz",
+ ],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "../../../../../../../../../../foo/bar/baz",
+ parent => "../../../../../../../../../../foo/bar",
+ },
+ {
+ name => "three components, parent directory reference (10, middle)",
+ path => "foo/../../../../../../../../../../bar/../../../../../../../../../../baz",
+ components => [
+ "foo",
+ "..", "..", "..", "..", "..", "..", "..", "..", "..", "..",
+ "bar",
+ "..", "..", "..", "..", "..", "..", "..", "..", "..", "..",
+ "baz"
+ ],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/../../../../../../../../../../bar/../../../../../../../../../../baz",
+ parent => "foo/../../../../../../../../../../bar/../../../../../../../../../..",
+ },
+ {
+ name => "three components, parent directory reference (10, end)",
+ path => "foo/bar/baz/../../../../../../../../../..",
+ components => [
+ "foo", "bar", "baz", "..", "..", "..", "..", "..", "..", "..", "..", "..", "..",
+ ],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../../../../../../../../../..",
+ parent => "foo/bar/baz/../../../../../../../../..",
+ },
+ {
+ name => "three components, parent directory reference (1, end), trailing slashes (1)",
+ path => "foo/bar/baz/../",
+ components => ["foo", "bar", "baz", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/..",
+ parent => "foo/bar/baz",
+ },
+ {
+ name => "three components, parent directory reference (2, end), trailing slashes (1)",
+ path => "foo/bar/baz/../../",
+ components => ["foo", "bar", "baz", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../..",
+ parent => "foo/bar/baz/..",
+ },
+ {
+ name => "three components, parent directory reference (1, end), trailing slashes (2)",
+ path => "foo/bar/baz/..//",
+ components => ["foo", "bar", "baz", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/..",
+ parent => "foo/bar/baz",
+ },
+ {
+ name => "three components, parent directory reference (2, end), trailing slashes (2)",
+ path => "foo/bar/baz/../..//",
+ components => ["foo", "bar", "baz", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../..",
+ parent => "foo/bar/baz/..",
+ },
+ {
+ name => "three components, parent directory reference (3, end), trailing slashes (1)",
+ path => "foo/bar/baz/../../../",
+ components => ["foo", "bar", "baz", "..", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../../..",
+ parent => "foo/bar/baz/../..",
+ },
+ {
+ name => "three components, parent directory reference (1, end), trailing slashes (3)",
+ path => "foo/bar/baz/..///",
+ components => ["foo", "bar", "baz", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/..",
+ parent => "foo/bar/baz",
+ },
+ {
+ name => "three components, parent directory reference (3, end), trailing slashes (3)",
+ path => "foo/bar/baz/../../..///",
+ components => ["foo", "bar", "baz", "..", "..", ".."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar/baz/../../..",
+ parent => "foo/bar/baz/../..",
+ },
+ # # # Miscellaneous
+ {
+ name => "preserve whitespace before path",
+ path => " \t \t\t foo/bar",
+ components => [" \t \t\t foo", "bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => " \t \t\t foo/bar",
+ parent => " \t \t\t foo",
+ },
+ {
+ name => "preserve whitespace after path",
+ path => "foo/bar \t\t \t ",
+ components => ["foo", "bar \t\t \t "],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo/bar \t\t \t ",
+ parent => "foo",
+ },
+ {
+ name => "preserve whitespace inbetween path",
+ path => "foo \t \t\t /\t \t bar",
+ components => ["foo \t \t\t ", "\t \t bar"],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => "foo \t \t\t /\t \t bar",
+ parent => "foo \t \t\t ",
+ },
+ {
+ name => "root path",
+ path => "/",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing slashes (1)",
+ path => "//",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing slashes (2)",
+ path => "///",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing slashes (10)",
+ path => "///////////",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing current dir references (1)",
+ path => "/.",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing current dir references (2)",
+ path => "/./.",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, trailing current dir references (10)",
+ path => "/./././././././././.",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "root path, various trailing slashes and current dir references",
+ path => "/.///././///./////././././////",
+ components => ["/"],
+ is_absolute => 1,
+ is_relative => "",
+ normalized => "/",
+ parent => undef,
+ },
+ {
+ name => "current dir reference",
+ path => ".",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing slashes (1)",
+ path => "./",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing slashes (2)",
+ path => ".//",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing slashes (10)",
+ path => ".//////////",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing current dir references (1)",
+ path => "./.",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing current dir references (2)",
+ path => "././.",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, trailing current dir references (10)",
+ path => "././././././././././.",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+ {
+ name => "current dir reference, various trailing slashes and current dir references",
+ path => "././//././///./////././././////",
+ components => ["."],
+ is_absolute => "",
+ is_relative => 1,
+ normalized => ".",
+ parent => "",
+ },
+];
+
+
+sub test_path_components : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_components: " . $case->{name};
+
+ my $components = eval { PVE::Path::path_components($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get components of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($components, $case->{components}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{components}));
+ diag("=== Got ===");
+ diag(explain($components));
+ }
+
+ return;
+}
+
+sub test_path_is_absolute : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_is_absolute: " . $case->{name};
+
+ my $is_abs = eval { PVE::Path::path_is_absolute($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to determine whether path is absolute:\n$@");
+ return;
+ }
+
+ # Note: `!is()` isn't the same as `isnt()` -- we want extra output here
+ # if the check fails; can't do that with `isnt()`
+ if (!is($is_abs, $case->{is_absolute}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{is_absolute}));
+ diag("=== Got ===");
+ diag(explain($is_abs));
+ }
+
+ return;
+}
+
+sub test_path_is_relative : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_is_relative: " . $case->{name};
+
+ my $is_rel = eval { PVE::Path::path_is_relative($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to determine whether path is relative:\n$@");
+ return;
+ }
+
+ # Note: `!is()` isn't the same as `isnt()` -- we want extra output here
+ # if the check fails; can't do that with `isnt()`
+ if (!is($is_rel, $case->{is_relative}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{is_relative}));
+ diag("=== Got ===");
+ diag(explain($is_rel));
+ }
+
+ return;
+}
+
+sub test_path_normalize : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_normalize: " . $case->{name};
+
+ my $normalized = eval { PVE::Path::path_normalize($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to normalize path:\n$@");
+ return;
+ }
+
+ # Note: `!is()` isn't the same as `isnt()` -- we want extra output here
+ # if the check fails; can't do that with `isnt()`
+ if (!is($normalized, $case->{normalized}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{normalized}));
+ diag("=== Got ===");
+ diag(explain($normalized));
+ }
+
+ return;
+}
+
+sub test_path_parent : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_parent: " . $case->{name};
+
+ my $parent = eval { PVE::Path::path_parent($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get parent from path:\n$@");
+ return;
+ }
+
+ # Note: `!is()` isn't the same as `isnt()` -- we want extra output here
+ # if the check fails; can't do that with `isnt()`
+ if (!is($parent, $case->{parent}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{parent}));
+ diag("=== Got ===");
+ diag(explain($parent));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_components,
+ \&test_path_is_absolute,
+ \&test_path_is_relative,
+ \&test_path_normalize,
+ \&test_path_parent,
+ ];
+
+ plan(tests => scalar($cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($cases->@*) {
+ for my $test_sub ($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 $@;
+ }
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
diff --git a/test/Path/path_comparison_tests.pl b/test/Path/path_comparison_tests.pl
new file mode 100755
index 0000000..c809a33
--- /dev/null
+++ b/test/Path/path_comparison_tests.pl
@@ -0,0 +1,859 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_starts_with_cases = [
+ {
+ name => "empty path starts with empty path",
+ path => "",
+ other_path => "",
+ expected => 1,
+ },
+ {
+ name => "root starts with empty path",
+ path => "/",
+ other_path => "",
+ expected => undef,
+ },
+ {
+ name => "empty path starts with root",
+ path => "",
+ other_path => "/",
+ expected => undef,
+ },
+ {
+ name => "foo starts with foo",
+ path => "foo",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo/ starts with foo",
+ path => "foo/",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo starts with foo/",
+ path => "foo",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo/ starts with foo/",
+ path => "foo/",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo starts with bar",
+ path => "foo",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo/ starts with bar",
+ path => "foo/",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo starts with bar/",
+ path => "foo",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "foo/ starts with bar/",
+ path => "foo/",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "/foo starts with /",
+ path => "/foo",
+ other_path => "/",
+ expected => 1,
+ },
+ {
+ name => "/foo starts with /foo",
+ path => "/foo",
+ other_path => "/foo",
+ expected => 1,
+ },
+ {
+ name => "/foo starts with foo",
+ path => "/foo",
+ other_path => "foo",
+ expected => undef,
+ },
+ {
+ name => "foo/bar starts with foo",
+ path => "foo/bar",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo/bar starts with foo/bar",
+ path => "foo/bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar starts with foo/bar/",
+ path => "foo/bar",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ starts with foo/bar",
+ path => "foo/bar/",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ starts with foo/bar/",
+ path => "foo/bar/",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar starts with /foo",
+ path => "/foo/bar",
+ other_path => "/foo",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar starts with /foo/bar",
+ path => "/foo/bar",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ starts with /foo/bar",
+ path => "/foo/bar/",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar starts with /foo/bar/",
+ path => "/foo/bar",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ starts with /foo/bar/",
+ path => "/foo/bar/",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/baz/quo/qux starts with foo/bar/baz/quo",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "foo/bar/baz/quo",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux starts with /foo/bar/baz/quo",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "/foo/bar/baz/quo",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/baz/quo/qux starts with one/two/three",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "one/two/three",
+ expected => undef,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux starts with /one/two/three",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "/one/two/three",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with /etc/pve",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with /etc/pve/firewall/cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with"
+ . " ///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with /etc/ceph",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/ceph",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with /etc/pve/firewall/cluster.fw.gz",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw.gz",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " starts with"
+ . " ///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ expected => undef,
+ },
+ {
+ name => "foo/../bar starts with foo/..",
+ path => "foo/../bar",
+ other_path => "foo/..",
+ expected => 1,
+ },
+ {
+ name => "foo/./bar starts with foo/bar",
+ path => "foo/./bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+];
+
+sub test_path_starts_with : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_starts_with: " . $case->{name};
+
+ my $result = eval {
+ PVE::Path::path_starts_with($case->{path}, $case->{other_path});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Encountered exception while running path_starts_with():\n$@");
+ return;
+ }
+
+ if (!is($result, $case->{expected}, $name)) {
+ my $expected_txt = $case->{expected} ?
+ "path starts with other_path"
+ : "path doesn't start with other path";
+
+ diag("path = " . $case->{path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{path})) . ")");
+ diag("other_path = " . $case->{other_path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{other_path})) . ")");
+ }
+
+ return;
+}
+
+my $path_ends_with_cases = [
+ {
+ name => "empty path ends with empty path",
+ path => "",
+ other_path => "",
+ expected => 1,
+ },
+ {
+ name => "root ends with empty path",
+ path => "/",
+ other_path => "",
+ expected => undef,
+ },
+ {
+ name => "empty path ends with root",
+ path => "",
+ other_path => "/",
+ expected => undef,
+ },
+ {
+ name => "foo ends with foo",
+ path => "foo",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo/ ends with foo",
+ path => "foo/",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo ends with foo/",
+ path => "foo",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo/ ends with foo/",
+ path => "foo/",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo ends with bar",
+ path => "foo",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo/ ends with bar",
+ path => "foo/",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo ends with bar/",
+ path => "foo",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "foo/ ends with bar/",
+ path => "foo/",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "/foo ends with /",
+ path => "/foo",
+ other_path => "/",
+ expected => undef,
+ },
+ {
+ name => "/foo ends with /foo",
+ path => "/foo",
+ other_path => "/foo",
+ expected => 1,
+ },
+ {
+ name => "/foo ends with foo",
+ path => "/foo",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo/bar ends with foo",
+ path => "foo/bar",
+ other_path => "foo",
+ expected => undef,
+ },
+ {
+ name => "foo/bar ends with bar",
+ path => "foo/bar",
+ other_path => "bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar ends with foo/bar",
+ path => "foo/bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar ends with foo/bar/",
+ path => "foo/bar",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ ends with foo/bar",
+ path => "foo/bar/",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ ends with foo/bar/",
+ path => "foo/bar/",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar ends with /foo",
+ path => "/foo/bar",
+ other_path => "/foo",
+ expected => undef,
+ },
+ {
+ name => "/foo/bar ends with /foo/bar",
+ path => "/foo/bar",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ ends with /foo/bar",
+ path => "/foo/bar/",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar ends with /foo/bar/",
+ path => "/foo/bar",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ ends with /foo/bar/",
+ path => "/foo/bar/",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/baz/quo/qux ends with bar/baz/quo/qux",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "bar/baz/quo/qux",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux ends with bar/baz/quo/qux",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "bar/baz/quo/qux",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/baz/quo/qux ends with one/two/three",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "one/two/three",
+ expected => undef,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux ends with /one/two/three",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "/one/two/three",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with firewall/cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "firewall/cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with /etc/pve/firewall/cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with"
+ . " ///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with firewall/cluster.fw.gz",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "firewall/cluster.fw.gz",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with /etc/pve/firewall/cluster.fw.gz",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw.gz",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " ends with"
+ . " ///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ expected => undef,
+ },
+ {
+ name => "foo/../bar ends with ../bar",
+ path => "foo/../bar",
+ other_path => "../bar",
+ expected => 1,
+ },
+ {
+ name => "foo/./bar ends with foo/bar",
+ path => "foo/./bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+];
+
+sub test_path_ends_with : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_ends_with: " . $case->{name};
+
+ my $result = eval {
+ PVE::Path::path_ends_with($case->{path}, $case->{other_path});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Encountered exception while running path_ends_with():\n$@");
+ return;
+ }
+
+ if (!is($result, $case->{expected}, $name)) {
+ my $expected_txt = $case->{expected} ? "true" : "false";
+
+ diag("path = " . $case->{path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{path})) . ")");
+ diag("other_path = " . $case->{other_path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{other_path})) . ")");
+ }
+
+ return;
+}
+
+my $path_equals_cases = [
+ {
+ name => "empty path equals empty path",
+ path => "",
+ other_path => "",
+ expected => 1,
+ },
+ {
+ name => "root equals empty path",
+ path => "/",
+ other_path => "",
+ expected => undef,
+ },
+ {
+ name => "empty path equals root",
+ path => "",
+ other_path => "/",
+ expected => undef,
+ },
+ {
+ name => "foo equals foo",
+ path => "foo",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo/ equals foo",
+ path => "foo/",
+ other_path => "foo",
+ expected => 1,
+ },
+ {
+ name => "foo equals foo/",
+ path => "foo",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo/ equals foo/",
+ path => "foo/",
+ other_path => "foo/",
+ expected => 1,
+ },
+ {
+ name => "foo equals bar",
+ path => "foo",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo/ equals bar",
+ path => "foo/",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo equals bar/",
+ path => "foo",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "foo/ equals bar/",
+ path => "foo/",
+ other_path => "bar/",
+ expected => undef,
+ },
+ {
+ name => "/foo equals /",
+ path => "/foo",
+ other_path => "/",
+ expected => undef,
+ },
+ {
+ name => "/foo equals /foo",
+ path => "/foo",
+ other_path => "/foo",
+ expected => 1,
+ },
+ {
+ name => "/foo equals foo",
+ path => "/foo",
+ other_path => "foo",
+ expected => undef,
+ },
+ {
+ name => "foo/bar equals foo",
+ path => "foo/bar",
+ other_path => "foo",
+ expected => undef,
+ },
+ {
+ name => "foo/bar equals bar",
+ path => "foo/bar",
+ other_path => "bar",
+ expected => undef,
+ },
+ {
+ name => "foo/bar equals foo/bar",
+ path => "foo/bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar equals foo/bar/",
+ path => "foo/bar",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ equals foo/bar",
+ path => "foo/bar/",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/ equals foo/bar/",
+ path => "foo/bar/",
+ other_path => "foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar equals /foo",
+ path => "/foo/bar",
+ other_path => "/foo",
+ expected => undef,
+ },
+ {
+ name => "/foo/bar equals /foo/bar",
+ path => "/foo/bar",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ equals /foo/bar",
+ path => "/foo/bar/",
+ other_path => "/foo/bar",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar equals /foo/bar/",
+ path => "/foo/bar",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/ equals /foo/bar/",
+ path => "/foo/bar/",
+ other_path => "/foo/bar/",
+ expected => 1,
+ },
+ {
+ name => "foo/bar/baz/quo/qux equals foo/bar/baz/quo/qux",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "foo/bar/baz/quo/qux",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux equals /foo/bar/baz/quo/qux",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "/foo/bar/baz/quo/qux",
+ expected => 1,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux equals foo/bar/baz/quo/qux",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "foo/bar/baz/quo/qux",
+ expected => undef,
+ },
+ {
+ name => "foo/bar/baz/quo/qux equals one/two/three",
+ path => "foo/bar/baz/quo/qux",
+ other_path => "one/two/three",
+ expected => undef,
+ },
+ {
+ name => "/foo/bar/baz/quo/qux equals /one/two/three",
+ path => "/foo/bar/baz/quo/qux",
+ other_path => "/one/two/three",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals /etc/pve",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals firewall/cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "firewall/cluster.fw",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals /etc/pve/firewall/cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals"
+ . " ///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve//./././firewall/.//././././././././///cluster.fw",
+ expected => 1,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals firewall/cluster.fw.gz",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "firewall/cluster.fw.gz",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals /etc/pve/firewall/cluster.fw.gz",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "/etc/pve/firewall/cluster.fw.gz",
+ expected => undef,
+ },
+ {
+ name => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw"
+ . " equals"
+ . " ///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ path => "//./././///././//etc/.//./pve/././//.//firewall/././cluster.fw",
+ other_path => "///etc/////././././////pve/oh/no/./././firewall/.//././././././././///cluster.fw",
+ expected => undef,
+ },
+ {
+ name => "foo/../bar equals foo/..",
+ path => "foo/../bar",
+ other_path => "foo/..",
+ expected => undef,
+ },
+ {
+ name => "foo/../bar equals ../bar",
+ path => "foo/../bar",
+ other_path => "../bar",
+ expected => undef,
+ },
+ {
+ name => "foo/./bar equals foo/bar",
+ path => "foo/./bar",
+ other_path => "foo/bar",
+ expected => 1,
+ },
+];
+
+sub test_path_equals : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_equals: " . $case->{name};
+
+ my $result = eval {
+ PVE::Path::path_equals($case->{path}, $case->{other_path});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Encountered exception while running path_equals():\n$@");
+ return;
+ }
+
+ if (!is($result, $case->{expected}, $name)) {
+ my $expected_txt = $case->{expected} ? "true" : "false";
+
+ diag("path = " . $case->{path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{path})) . ")");
+ diag("other_path = " . $case->{other_path});
+ diag(" (" . join(", ", PVE::Path::path_components($case->{other_path})) . ")");
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ plan(
+ tests => scalar($path_starts_with_cases->@*)
+ + scalar($path_ends_with_cases->@*)
+ + scalar($path_equals_cases->@*)
+ );
+
+ for my $case ($path_starts_with_cases->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ test_path_starts_with($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_ends_with_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_ends_with($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_equals_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_equals($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
diff --git a/test/Path/path_file_ops_tests.pl b/test/Path/path_file_ops_tests.pl
new file mode 100755
index 0000000..ee32307
--- /dev/null
+++ b/test/Path/path_file_ops_tests.pl
@@ -0,0 +1,1220 @@
+#!/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 { PVE::Path::path_file_suffixes($case->{path}); };
+
+ 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 { PVE::Path::path_file_parts($case->{path}); };
+
+ 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();
diff --git a/test/Path/path_join_tests.pl b/test/Path/path_join_tests.pl
new file mode 100755
index 0000000..1a2eb72
--- /dev/null
+++ b/test/Path/path_join_tests.pl
@@ -0,0 +1,310 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $cases = [
+ {
+ name => "no components",
+ components => [],
+ joined => "",
+ },
+ {
+ name => "one component, relative",
+ components => ["foo"],
+ joined => "foo",
+ },
+ {
+ name => "one component, with root",
+ components => ["/", "foo"],
+ joined => "/foo",
+ },
+ {
+ name => "current path reference",
+ components => ["."],
+ joined => ".",
+ },
+ {
+ name => "multiple components, relative",
+ components => ["foo", "bar", "baz"],
+ joined => "foo/bar/baz",
+ },
+ {
+ name => "multiple components, with root",
+ components => ["/", "foo", "bar", "baz"],
+ joined => "/foo/bar/baz",
+ },
+ {
+ name => "multiple components, root inbetween",
+ components => ["foo", "bar", "/", "baz", "quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "multiple components, with root, root inbetween",
+ components => ["/", "foo", "bar", "/", "baz", "quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "multiple components, root at end",
+ components => ["foo", "bar", "baz", "/"],
+ joined => "/",
+ },
+ {
+ name => "multiple components, with root, root at end",
+ components => ["/", "foo", "bar", "baz", "/"],
+ joined => "/",
+ },
+ {
+ name => "multiple components, current path references inbetween",
+ components => ["foo", ".", "bar", ".", ".", "baz"],
+ joined => "foo/./bar/././baz",
+ },
+ {
+ name => "multiple components, with root, current path references inbetween",
+ components => ["/", "foo", ".", "bar", ".", ".", "baz"],
+ joined => "/foo/./bar/././baz",
+ },
+ {
+ name => "multiple components, current path references at end",
+ components => ["foo", "bar", ".", "."],
+ joined => "foo/bar/./.",
+ },
+ {
+ name => "multiple components, with root, current path references at end",
+ components => ["/", "foo", "bar", ".", "."],
+ joined => "/foo/bar/./.",
+ },
+ {
+ name => "multiple components, current path reference at start",
+ components => [".", "foo", "bar"],
+ joined => "./foo/bar",
+ },
+ {
+ name => "multiple components, parent path references inbetween",
+ components => ["foo", "..", "bar", "..", "..", "baz"],
+ joined => "foo/../bar/../../baz",
+ },
+ {
+ name => "multiple components, with root, parent path references inbetween",
+ components => ["/", "foo", "..", "bar", "..", "..", "baz"],
+ joined => "/foo/../bar/../../baz",
+ },
+ {
+ name => "multiple components, parent path references at end",
+ components => ["foo", "bar", "..", ".."],
+ joined => "foo/bar/../..",
+ },
+ {
+ name => "multiple components, with root, parent path references at end",
+ components => ["/", "foo", "bar", "..", ".."],
+ joined => "/foo/bar/../..",
+ },
+ {
+ name => "multiple components, parent path reference at start",
+ components => ["..", "foo", "bar"],
+ joined => "../foo/bar",
+ },
+ {
+ name => "relative paths (2)",
+ components => ["foo/bar", "baz/quo"],
+ joined => "foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (3)",
+ components => ["foo/bar", "baz/quo", "one/two/three"],
+ joined => "foo/bar/baz/quo/one/two/three",
+ },
+ {
+ name => "relative paths (2) with root inbetween",
+ components => ["foo/bar", "/","baz/quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "relative paths (3) with root inbetween",
+ components => ["foo/bar", "/","baz/quo", "/", "one/two/three"],
+ joined => "/one/two/three",
+ },
+ {
+ name => "absolute paths (2)",
+ components => ["/foo/bar", "/baz/quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "relative paths (2, not normalized)",
+ components => ["foo/.///.//.///bar", "baz/.////./quo"],
+ joined => "foo/.///.//.///bar/baz/.////./quo",
+ },
+ {
+ name => "relative paths (3, not normalized)",
+ components => ["foo/.///.//.///bar", "baz/.////./quo", "one/two//three///"],
+ joined => "foo/.///.//.///bar/baz/.////./quo/one/two//three///",
+ },
+ {
+ name => "relative paths (2), trailing slashes",
+ components => ["foo/bar/", "baz/quo/"],
+ joined => "foo/bar/baz/quo/",
+ },
+ {
+ name => "relative paths (3), trailing slashes",
+ components => ["foo/bar/", "baz/quo", "one/two/three/"],
+ joined => "foo/bar/baz/quo/one/two/three/",
+ },
+ {
+ name => "relative path and empty path at end",
+ components => ["foo/bar", ""],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty paths at end (3)",
+ components => ["foo/bar", "", "", ""],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty path at start",
+ components => ["", "foo/bar"],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty paths at start (3)",
+ components => ["", "", "", "foo/bar"],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2)",
+ components => ["", "", "foo/bar", "", "", "baz/quo", "", ""],
+ joined => "foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2), with root at start",
+ components => ["/", "", "", "foo/bar", "", "", "baz/quo", "", ""],
+ joined => "/foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2), with root in middle",
+ components => ["", "", "foo/bar", "", "/", "", "baz/quo", "", ""],
+ joined => "/baz/quo",
+ },
+ {
+ name => "undef among paths",
+ components => ["foo", "bar/baz", undef, "quo", "qux"],
+ joined => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_join : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_join: " . $case->{name};
+
+ my $joined = eval { PVE::Path::path_join($case->{components}->@*); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to join components of path:\n$@");
+ return;
+ }
+
+ if (!is($joined, $case->{joined}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{joined}));
+ diag("=== Got ===");
+ diag(explain($joined));
+ }
+
+ return;
+}
+
+# This is basically the same as above, but checks whether the joined path
+# is still the same when normalized after splitting and joining it again.
+sub test_path_join_consistent : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_join (consistency): " . $case->{name};
+
+ my $joined = eval { PVE::Path::path_join($case->{components}->@*); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to join components of path:\n$@");
+ return;
+ }
+
+ my $joined_again = eval {
+ my @components = PVE::Path::path_components($joined);
+ PVE::Path::path_join(@components);
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to re-join previously joined path:\n$@");
+ return;
+ }
+
+ my $normalized = eval { PVE::Path::path_normalize($joined_again); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to normalize re-joined path:\n$@");
+ return;
+ }
+
+ my $expected_normalized = eval { PVE::Path::path_normalize($case->{joined}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to normalize expected path:\n$@");
+ return;
+ }
+
+ if (!is($normalized, $expected_normalized, $name)) {
+ diag("=== Expected ===");
+ diag(explain($expected_normalized));
+ diag("=== Got ===");
+ diag(explain($normalized));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_join,
+ \&test_path_join_consistent,
+ ];
+
+ plan(tests => scalar($cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($cases->@*) {
+ for my $test_sub ($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 $@;
+ }
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
diff --git a/test/Path/path_push_tests.pl b/test/Path/path_push_tests.pl
new file mode 100755
index 0000000..3b006a0
--- /dev/null
+++ b/test/Path/path_push_tests.pl
@@ -0,0 +1,159 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $cases = [
+ {
+ name => "push empty onto empty path",
+ path => "",
+ to_push => "",
+ pushed => "",
+ },
+ {
+ name => "push empty onto root",
+ path => "/",
+ to_push => "",
+ pushed => "/",
+ },
+ {
+ name => "push single component onto empty path",
+ path => "",
+ to_push => "foo",
+ pushed => "foo",
+ },
+ {
+ name => "push single component onto root",
+ path => "/",
+ to_push => "foo",
+ pushed => "/foo",
+ },
+ {
+ name => "push single component onto single component",
+ path => "foo",
+ to_push => "bar",
+ pushed => "foo/bar",
+ },
+ {
+ name => "push single component onto single component with trailing slash",
+ path => "foo/",
+ to_push => "bar",
+ pushed => "foo/bar",
+ },
+ {
+ name => "push single component with trailing slath onto single component",
+ path => "foo",
+ to_push => "bar/",
+ pushed => "foo/bar/",
+ },
+ {
+ name => "push single component with trailing slash"
+ . " onto single component with trailing slash",
+ path => "foo/",
+ to_push => "bar/",
+ pushed => "foo/bar/",
+ },
+ {
+ name => "push relative path onto relative path",
+ path => "foo/bar",
+ to_push => "baz/quo",
+ pushed => "foo/bar/baz/quo",
+ },
+ {
+ name => "push relative path onto relative path with trailing slash",
+ path => "foo/bar/",
+ to_push => "baz/quo",
+ pushed => "foo/bar/baz/quo",
+ },
+ {
+ name => "push relative path with trailing slash onto relative path",
+ path => "foo/bar",
+ to_push => "baz/quo/",
+ pushed => "foo/bar/baz/quo/",
+ },
+ {
+ name => "push relative path with trailing slash onto relative path with trailing slash",
+ path => "foo/bar/",
+ to_push => "baz/quo/",
+ pushed => "foo/bar/baz/quo/",
+ },
+ {
+ name => "push root onto relative path",
+ path => "foo/bar",
+ to_push => "/",
+ pushed => "/",
+ },
+ {
+ name => "push root onto absolute path",
+ path => "/foo/bar",
+ to_push => "/",
+ pushed => "/",
+ },
+ {
+ name => "push absolute path onto relative path",
+ path => "foo/bar",
+ to_push => "/baz/quo",
+ pushed => "/baz/quo",
+ },
+ {
+ name => "push absolute path onto absolute path",
+ path => "/foo/bar",
+ to_push => "/baz/quo",
+ pushed => "/baz/quo",
+ },
+];
+
+sub test_path_push : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_push: " . $case->{name};
+
+ my $pushed = eval { PVE::Path::path_push($case->{path}, $case->{to_push}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to push onto path:\n$@");
+ return;
+ }
+
+ if (!is($pushed, $case->{pushed}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{pushed}));
+ diag("=== Got ===");
+ diag(explain($pushed));
+ }
+
+ return;
+}
+
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_push,
+ ];
+
+ plan(tests => scalar($cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($cases->@*) {
+ for my $test_sub ($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 $@;
+ }
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
2.39.5
More information about the pve-devel
mailing list