* [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem
@ 2024-12-19 18:31 Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 1/4] introduce PVE::Path Max Carrara
` (4 more replies)
0 siblings, 5 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-19 18:31 UTC (permalink / raw)
To: pve-devel
Introduce and Package PVE::Path & PVE::Filesystem
=================================================
tl;dr is at the bottom.
PVE::Path
---------
Concerns itself with file & directory path operations and does not
manipulate the filesystem.
This module adds a lot of functionalities that more modern path
libraries provide, mainly in order to address the shortcomings of the
Perl core modules. At the same time, this module takes a completely
functional approach, which means that anything it offers can just be
used ad hoc where needed.
The purpose of PVE::Path is to provide a "one-stop shop" for everything
that concerns file path operations. Additionally, none of the functions
it adds should have any "surprises" like a lot of Perl stuff inevitably
has. Inspiration is taken from more modern libraries like Rust's
`std::path` [1] and Python's `pathlib` [2].
I also want to address some questions that came up during development:
Q: How do you ensure that this module doesn't become another competing
standard? [3]
A: The stuff in the core modules is either lacking or clunky (sorry for
being blunt); PVE::Path makes things easier and actually implements
many features that the core modules don't have, such as getting the
parent directory of a path or checking if two paths are the same etc.
Also, this will be very useful for things related to the storage API
-- the frustrations of not being able to get the parent dir of a
path are what actually prompted me to implement this.
Q: Are you testing this?
A: Yes, there are 1050 tests in total, because testing plain functions
is easy and parameterizable.
Q: Why not use something from CPAN?
A: The (useful) modules from CPAN all use some kind of object-based
abstraction, for which we would (probably) have to adapt a lot of
code in order to be able to use those. This provides barely any
benefit for the amount of churn that would be necessary. As mentioned
above, PVE::Path strictly only consists of functions, so they can
just be dropped in whenever some path operations need to be
performed.
PVE::Filesystem
---------------
This module can be seen as the complement to PVE::Path that does
actually modify things on the filesystem, as the name implies.
Right now, this only adds two simple wrappers for two functions of the
Perl core modules, but is added here already to pave the way for further
expansion in the future, whenever the need to do so arises.
In the future this will go in the direction of Rust's `std::fs` [4] and
some other libraries I've seen out there, while sticking to the
functional-only, no-surprises approach like PVE::Path does.
TL;DR
-----
- PVE::Path implements basic file path manipulations that currently
don't seem to exist and provides them in an accessible,
non-surprising, straightforward, ergonomic manner
- PVE::Filesystem is for FS-altering utils, but is rather bare-bones at
the moment, containing only two wrappers. The module is added solely
so that it can be expanded when needed
Closing Remarks
---------------
Whether these modules are actually as fancy and ergonomic and $BUZZWORD
as I'm advertising here is of course left to be determined by my fellow
colleagues, so I'm really thankful for any feedback on this. <3
Every single function is documented, so it would be nice if I could get
some feedback on that as well. Even if there is just a little ambiguity,
please let me know -- I want these modules to be absolutely foolproof.
References
----------
[1]: https://doc.rust-lang.org/std/path/index.html
[2]: https://docs.python.org/3/library/pathlib.html
[3]: https://xkcd.com/927/
[4]: https://doc.rust-lang.org/std/fs/index.html
Summary of Changes
------------------
Max Carrara (4):
introduce PVE::Path
add tests for PVE::Path
introduce PVE::Filesystem
debian: introduce package libproxmox-fs-path-utils-perl
debian/control | 6 +
debian/libproxmox-fs-path-utils-perl.install | 2 +
debian/libpve-common-perl.install | 29 +
src/Makefile | 2 +
src/PVE/Filesystem.pm | 78 +
src/PVE/Path.pm | 956 +++++++++++++
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 +++
13 files changed, 4976 insertions(+), 1 deletion(-)
create mode 100644 debian/libproxmox-fs-path-utils-perl.install
create mode 100644 debian/libpve-common-perl.install
create mode 100644 src/PVE/Filesystem.pm
create mode 100644 src/PVE/Path.pm
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
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* [pve-devel] [PATCH v1 pve-common 1/4] introduce PVE::Path
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
@ 2024-12-19 18:31 ` Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path Max Carrara
` (3 subsequent siblings)
4 siblings, 0 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-19 18:31 UTC (permalink / raw)
To: pve-devel
The PVE::Path module concerns itself with file / directory path
operations, like getting the parent directory of a path, extracting
the file name of a path, splitting a path into its individual
components, joining path components together, comparing paths, and so
on.
This module is added here in order to address the shortcomings of the
Perl core modules (such as lacking a lot the aforementioned
functionalities) without relying on some kind of object-based
abstraction.
PVE::Path strictly only contains functions that manipulate file paths
without meddling with the filesystem. The reasoning here is to be able
to just import any function when its necessary without having to
change the surrounding code in order to adapt to some kind of
abstraction.
The other motivation for this module is that path manipulation
operations have been getting more and more common recently, especially
in regards to storage.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
src/Makefile | 1 +
src/PVE/Path.pm | 956 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 957 insertions(+)
create mode 100644 src/PVE/Path.pm
diff --git a/src/Makefile b/src/Makefile
index 2d8bdc4..25bc490 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -23,6 +23,7 @@ LIB_SOURCES = \
LDAP.pm \
Network.pm \
OTP.pm \
+ Path.pm \
PBSClient.pm \
PTY.pm \
ProcFSTools.pm \
diff --git a/src/PVE/Path.pm b/src/PVE/Path.pm
new file mode 100644
index 0000000..d411027
--- /dev/null
+++ b/src/PVE/Path.pm
@@ -0,0 +1,956 @@
+=head1 NAME
+
+C<PVE::Path> - Utilities related to handling file and directory paths
+
+=head1 DESCRIPTION
+
+This module provides functions concerned with file and directory path
+manipulation.
+
+None of the functions provided alter the filesystem in any way.
+
+The reason for this module's existence is to address a couple shortcomings:
+
+=over
+
+=item 1. The Perl core modules lack most of what is required for manipulating
+paths, for example getting the parent directory of a path, extracting the
+prefix of a file name (the "stem"), extracting the suffixes of a file name (the
+"endings" or "extensions"), checking whether two paths are the same, and so on.
+
+=item 2. If the Perl core modules provide something in that regard, it's usually
+provided in a not very ergonomic manner (L<C<File::Basename>>).
+
+=item 3. Additionally, the path utilities of the core modules are scattered
+across multiple modules, making them hard to discover.
+
+=item 4. Third-party libraries on CPAN mostly provide objects representing
+paths. Using any of these would require fundamental changes on how file paths
+are handled throughout our code, for almost no benefit.
+
+=back
+
+C<L<PVE::Path>> instead does without objects and strictly provides functions
+for path manipulation only. Any operation that is needed can simply be
+performed ad hoc by importing the corresponding function and doesn't require
+the surrounding code to conform to an abstraction like a path object.
+
+Additionally, some of the core modules' functionality is re-exported or
+re-implemented for ergonomic or logical purposes. The goal is to provide
+functions that don't come with any surprises and just behave like one assumes
+they would.
+
+This module takes inspiration from Rust's C<std::path> and Python's C<pathlib>,
+which are more modern path manipulation libraries.
+
+=head1 LIMITATIONS
+
+This module is limited to manipulating Unix-like / Linux file paths.
+
+=cut
+
+package PVE::Path;
+
+use strict;
+use warnings;
+
+use Carp qw(carp croak confess);
+use File::Spec ();
+use List::Util qw(any zip_shortest zip_longest);
+
+use Exporter qw(import);
+
+our @EXPORT_OK = qw(
+ path_is_absolute
+ path_is_relative
+
+ path_components
+ path_join
+
+ path_normalize
+
+ path_parent
+ path_push
+ path_pop
+
+ path_file_name
+ path_with_file_name
+
+ path_file_prefix
+ path_with_file_prefix
+
+ path_file_suffixes
+ path_with_file_suffixes
+
+ path_file_suffix
+ path_with_file_suffix
+
+ path_file_parts
+
+ path_starts_with
+ path_ends_with
+ path_equals
+);
+
+=head2 FUNCTIONS
+
+=cut
+
+=head3 path_is_absolute($path)
+
+Checks whether the given C<$path> is absolute (starts with a C</>).
+
+Throws an exception if C<$path> is C<undef> or if called in list context.
+
+=cut
+
+sub path_is_absolute : prototype($) {
+ my ($path) = @_;
+
+ croak "subroutine called in list context" if wantarray;
+ croak "\$path is undef" if !defined($path);
+
+ return $path =~ m#^/#;
+}
+
+=head3 path_is_relative($path)
+
+Checks whether the given C<$path> is relative (doesn't start with a C</>).
+The opposite of C<L<< path_is_absolute()|/"path_is_absolute($path)" >>>.
+
+Throws an exception if C<$path> is C<undef> or if called in list context.
+
+=cut
+
+sub path_is_relative : prototype($) {
+ my ($path) = @_;
+
+ croak "subroutine called in list context" if wantarray;
+ croak "\$path is undef" if !defined($path);
+
+ return $path !~ m#^/#;
+}
+
+=head3 path_components($path)
+
+Returns a list of the given C<$path>'s individual components.
+
+In scalar context, returns a reference to a list.
+
+The C<$path> is normalized a little during parsing:
+
+=over
+
+=item Repeated occurrences of C</> are removed, so C<foo/bar> and C<foo//bar>
+both have C<foo> and C<bar> as components.
+
+=item Trailing slashes C</> are removed.
+
+=item Occurrences of C<.> are normalized away, except the first C<.> at
+beginning of a path. This means that C<foo/bar>, C<foo/./bar>, C<foo/bar/.>,
+C<foo/././bar/./.>, etc. all have C<foo> and C<bar> as components, while
+C<./foo/bar>, C<./././foo/bar>, C<./foo/./bar/.> have C<.>, C<foo> and C<bar>
+as components.
+
+=back
+
+No other normalization is performed to account for the possibility of symlinks
+existing. This means that C<foo/baz> and C<foo/bar/../baz> are distinct (because
+C<bar> could be a symlink and thus C<foo> isn't its parent).
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_components : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $is_abs = path_is_absolute($path);
+ my $has_cur_dir = $path =~ m#^\.$|^\./#;
+
+ my @components = split('/', $path);
+ my @normalized_components = ();
+
+ for my $component (@components) {
+ next if $component eq '' || $component eq '.';
+
+ push(@normalized_components, $component);
+ }
+
+ unshift(@normalized_components, '/') if $is_abs;
+ unshift(@normalized_components, '.') if $has_cur_dir;
+
+ return @normalized_components if wantarray;
+ return \@normalized_components;
+}
+
+
+=head3 path_join(@paths)
+
+Joins multiple paths together. All kinds of paths are supported.
+
+Does not perform any C<L<< normalization|/"path_normalize($path)" >>>.
+
+Throws an exception if any of the passed C<@paths> is C<undef>.
+
+=cut
+
+sub path_join : prototype(@) {
+ my (@paths) = @_;
+
+ if (!scalar(@paths)) {
+ return '';
+ }
+
+ croak "one of the provided paths is undef" if any { !defined($_) } @paths;
+
+ # Find the last occurrence of a root directory and start conjoining the
+ # components from there onwards
+ my $index = scalar(@paths) - 1;
+ while ($index > 0) {
+ last if $paths[$index] =~ m#^/#;
+ $index--;
+ }
+
+ @paths = @paths[$index .. (scalar(@paths) - 1)];
+
+ my $resulting_path = shift @paths;
+
+ for my $path (@paths) {
+ $resulting_path = path_push($resulting_path, $path);
+ }
+
+ return $resulting_path;
+}
+
+=head3 path_normalize($path)
+
+Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
+C<$path>.
+
+This removes unnecessary components of a path that can be safely
+removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
+
+For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
+C<foo/bar/baz>.
+
+B<Note:> This will I<not> remove components referencing the parent directory,
+i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
+remain as they are. However, the parent directory of C</> is C</>, so
+C</../../foo> will be normalized to C</foo>.
+
+Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
+
+=cut
+
+sub path_normalize : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $cleaned_path = eval {
+ File::Spec->canonpath($path);
+ };
+
+ croak "failed to clean up path: $@" if $@;
+
+ return $cleaned_path;
+}
+
+=head3 path_parent($path)
+
+Returns the given C<$path> without its final component, if there is one.
+
+Trailing and repeated occurrences of C</> and C<.> are normalized on the fly
+when needed. This means that e.g. C<foo////bar///.//> becomes C<foo>, but
+C<foo/.//bar//./baz> becomes C<foo/.//bar>.
+
+This function's behaviour is almost identical to Rust's
+L<< Path::parent|https://doc.rust-lang.org/std/path/struct.Path.html#method.parent >>,
+with a few adaptations made wherever Perl treats things differently:
+
+=over
+
+=item * C</foo/bar> becomes C</foo>, C<foo/bar> becomes C<foo>.
+
+=item * C</foo> becomes C</>.
+
+=item * C<foo/bar/..> becomes C<foo/bar>.
+
+=item * C<foo/../bar> becomes C<foo/..>.
+
+=item * C<foo> is interpreted as C<./foo> and becomes C<.>. This is because Perl's
+C<L<File::Spec/canonpath>> interprets C<./foo> and C<foo> as the same thing.
+
+=item * C</> and an I<empty string> result in C<undef> being returned.
+
+=item * C<.> results in an empty string.
+
+=back
+
+Will raise an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_parent : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if ($path eq '') {
+ return;
+ }
+
+ # A limit of -1 retains empty components at the end
+ my @components = split('/', $path, -1);
+
+ # Trim off needless extra components until actual final component is encountered, e.g.
+ # foo////bar////baz//// -> foo////bar////baz
+ # /// -> /
+ # ././//.///./ -> .
+ while (scalar(@components) > 1 && ($components[-1] eq '' || $components[-1] eq '.')) {
+ pop(@components);
+ }
+
+ my $final_component = pop(@components);
+
+ if (defined($final_component)) {
+ # We had a root dir with needless extra components, e.g. "//" or "////" or "//.///./" etc.
+ if ($final_component eq '') {
+ return;
+ }
+
+ # We had a current dir reference with needless extra components, e.g.
+ # "././" or ".///////" or "./././//./././//" etc.
+ if ($final_component eq '.') {
+ return "";
+ }
+ } else {
+ confess "\$final_component wasn't undef";
+ }
+
+ # Trim off needless extra components until actual parent component is encountered, like above
+ while (scalar(@components) > 1 && ($components[-1] eq '' || $components[-1] eq '.')) {
+ pop(@components);
+ }
+
+ # Handle lone root dir (@components with only one empty string)
+ if (scalar(@components) == 1 && $components[0] eq '') {
+ return '/';
+ }
+
+ return join('/', @components);
+}
+
+=head3 path_push($path, $other)
+
+Extends C<$path> with C<$other>, returning a new path.
+
+If C<$other> is absolute, it will be returned instead.
+
+Throws an exception if any of the arguments is C<undef>.
+
+=cut
+
+sub path_push : prototype($$) {
+ my ($path, $other) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other is undef" if !defined($other);
+
+ return $other if path_is_absolute($other);
+ return $path if $other eq '';
+
+ my $need_sep = $path ne '' && $path !~ m#/$#;
+
+ $path .= "/" if $need_sep;
+ $path .= $other;
+
+ return $path;
+}
+
+=head3 path_pop($path)
+
+Alias for C<L<< path_parent()|/"path_parent($path)" >>>.
+
+=cut
+
+sub path_pop : prototype($) {
+ my ($path) = @_;
+ return path_parent($path);
+}
+
+=head3 path_file_name($path)
+
+Returns the last component of the given C<$path>, if it is a legal file name,
+or C<undef> otherwise.
+
+If C<$path> is an empty string, C</>, C<.> or ends with a C<..> component,
+there is no valid file name.
+
+B<Note:> This does not check whether the given C<$path> actually points to a
+file or a directory etc.
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_name : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my @components = path_components($path);
+
+ if (!scalar(@components)) {
+ return;
+ }
+
+ if (
+ scalar(@components) == 1
+ && ($components[0] eq '/' || $components[0] eq '.')
+ ) {
+ return;
+ }
+
+ if ($components[-1] eq '..') {
+ return;
+ }
+
+ return $components[-1];
+}
+
+=head3 path_with_file_name($path, $file_name)
+
+Returns C<$path> with C<$file_name> as the new last component.
+
+This is essentially like calling C<L<< path_parent()|/"path_parent($path)" >>>
+and using C<L<< path_push()|/"path_push($path, $other)" >>> to append the new
+file name, but handles a few extra cases:
+
+=over
+
+=item * If C<$path> is C</>, appends C<$file_name>.
+
+=item * If C<$path> is an empty string, appends C<$file_name>.
+
+=item * If C<$path> ends with a parent directory reference (C<..>), replaces it
+with C<$file_name>.
+
+=back
+
+Throws an exception if any of the arguments is C<undef> or if C<$file_name>
+contains a path separator (C</>).
+
+=cut
+
+sub path_with_file_name : prototype($$) {
+ my ($path, $file_name) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$file_name is undef" if !defined($file_name);
+ croak "\$file_name contains a path separator: $file_name" if $file_name =~ m|/|;
+
+ my $parent = path_parent($path);
+
+ # undef means that $path was either "" or "/", so we can just append to it
+ return ($path . $file_name) if !defined($parent);
+
+ return path_push($parent, $file_name);
+}
+
+my sub _path_file_prefix : prototype($) {
+ my ($file_name) = @_;
+
+ confess "\$file_name is undef" if !defined($file_name);
+
+ $file_name =~ s|^(\.*[^\.]*)||;
+ my $prefix = $1;
+
+ # sanity check
+ confess "\$prefix not matched" if !defined($prefix);
+
+ return ($prefix, $file_name);
+}
+
+=head3 path_file_prefix($path)
+
+Returns the prefix of the file name of the given C<$path>. If the C<$path> does
+not have a valid file name and thus no prefix, C<undef> is returned instead.
+
+The prefix of a file name is the part before any extensions (suffixes).
+
+ my $prefix = path_file_prefix("/etc/resolv.conf");
+ # resolv
+
+ my $prefix = path_file_prefix("/tmp/archive.tar.zst");
+ # archive
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_prefix : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ my ($prefix, undef) = _path_file_prefix($file_name);
+ return $prefix;
+}
+
+=head3 path_with_file_prefix($path, $prefix)
+
+Returns C<$path> with a new C<$prefix>. This is similar to
+C<L<< path_with_file_name()|/"path_with_file_name($path, $file_name)" >>>,
+except that the file prefix is replaced or appended.
+
+If C<$path> does not have a file name or if C<$prefix> is an empty string,
+C<undef> is returned.
+
+ my $new_path = path_with_file_prefix("/tmp/archive.tar.zst", "backup");
+ # /tmp/backup.tar.zst
+
+ my $new_path = path_with_file_prefix("/etc/pve", "ceph");
+ # /etc/ceph
+
+Throws an exception if any of the arguments is C<undef>, or if C<$prefix>
+contains a path separator (C</>), ends with C<.>, or is an empty string.
+
+=cut
+
+sub path_with_file_prefix : prototype($$) {
+ my ($path, $prefix) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$prefix is undef" if !defined($prefix);
+ croak "\$prefix contains a path separator" if $prefix =~ m|/|;
+ croak "\$prefix ends with a dot" if $prefix =~ m|\.$|;
+
+ return undef if $prefix eq '';
+ return undef if !defined(path_file_name($path));
+
+ return $path if $prefix eq '';
+
+ my $parent = path_parent($path);
+
+ # sanity check -- should not happen because we checked for file name,
+ # and the existence of a file name implies there's a parent
+ confess "parent of \$path is undef" if !defined($parent);
+
+ my @suffixes = path_file_suffixes($path);
+
+ my $file_name = join(".", $prefix, @suffixes);
+
+ return path_push($parent, $file_name);
+}
+
+my sub _path_file_suffixes : prototype($) {
+ my ($file_name_no_prefix) = @_;
+
+ confess "\$file_name_no_prefix is undef" if !defined($file_name_no_prefix);
+
+ # Suffixes are extracted "manually" because join()ing the result of split()
+ # results in a different file name than the original. Let's say you have a
+ # file named "foo.bar.". The correct suffixes would be ("bar", "").
+ # With split, you get the following:
+ # split(/\./, ".bar.") --> ("", "bar") --> join()ed to "foo..bar"
+ # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar."
+ my @suffixes = ();
+ while ($file_name_no_prefix =~ s|^(\.[^\.]*)||) {
+ my $suffix = $1;
+ $suffix =~ s|^\.||;
+ push(@suffixes, $suffix);
+ }
+
+ return @suffixes;
+}
+
+=head3 path_file_suffixes($path)
+
+Returns the suffixes of the C<$path>'s file name as a list. If the C<$path> does
+not have a valid file name, an empty list is returned instead.
+
+In scalar context, returns a reference to a list.
+
+The suffixes of a path are essentially the file name's extensions, the parts
+that come after the L<< prefix|/"path_file_prefix($path)" >>.
+
+ my @suffixes = path_file_suffixes("/etc/resolv.conf");
+ # ("conf")
+
+ my $suffixes = path_file_prefix("/tmp/archive.tar.zst");
+ # ["tar", "zst"]
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_suffixes : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ if (!defined($file_name)) {
+ return wantarray ? () : [];
+ }
+
+ (undef, $file_name) = _path_file_prefix($file_name);
+
+ my @suffixes = _path_file_suffixes($file_name);
+
+ return wantarray ? @suffixes : \@suffixes;
+}
+
+=head3 path_with_file_suffixes($path, @suffixes)
+
+Returns C<$path> with new C<@suffixes>. This is similar to
+C<L<< path_with_file_name()|/"path_with_file_name($path, $file_name)" >>>,
+except that the suffixes of the file name are replaced.
+
+If the C<$path> does not have a file name, C<undef> is returned.
+
+ my $new_path = path_with_file_suffixes("/tmp/archive.tar.zst", "pxar", "gz");
+ # /tmp/archive.pxar.gz
+
+ my $new_path = path_with_file_suffixes("/tmp/archive.tar.zst", "gz");
+ # /tmp/archive.gz
+
+If the file name has no suffixes, the C<@suffixes> are appended instead:
+
+ my $new_path = path_with_file_suffixes("/etc/resolv", "conf");
+ # /etc/resolv.conf
+
+ my $new_path = path_with_file_suffixes("/etc/resolv", "conf", "zst");
+ # /etc/resolv.conf.zst
+
+If there are no C<@suffixes> provided, the file name's suffixes will
+be removed (if there are any):
+
+ my $new_path = path_with_file_suffixes("/tmp/archive.tar.zst");
+ # /tmp/archive
+
+Note that an empty string is still a valid suffix (an "empty" file ending):
+
+ my $new_path = path_with_file_suffixes("/tmp/archive.tar.zst", "", "", "", "zst");
+ # /tmp/archive....zst
+
+Throws an exception if C<$path> or any of the C<@suffixes> is C<undef>, or
+if any suffix contains a path separator (C</>) or a C<.>.
+
+=cut
+
+sub path_with_file_suffixes : prototype($@) {
+ my ($path, @suffixes) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "one of the provided suffixes is undef"
+ if any { !defined($_) } @suffixes;
+ croak "one of the provided suffixes contains a path separator"
+ if any { $_ =~ m|/| } @suffixes;
+ croak "one of the provided suffixes contains a dot"
+ if any { $_ =~ m|\.| } @suffixes;
+
+ return undef if !defined(path_file_name($path));
+
+ my $parent = path_parent($path);
+
+ # sanity check -- should not happen because we checked for file name,
+ # and the existence of a file name implies there's a parent
+ confess "parent of \$path is undef" if !defined($parent);
+
+ # Don't modify $path if there are no suffixes to be removed
+ my @existing_suffixes = path_file_suffixes($path);
+ return $path if !scalar(@suffixes) && !scalar(@existing_suffixes);
+
+ my $prefix = path_file_prefix($path);
+
+ # sanity check
+ confess "\$prefix is undef" if !defined($prefix);
+
+ my $file_name = join(".", $prefix, @suffixes);
+
+ return path_push($parent, $file_name);
+}
+
+=head3 path_file_suffix($path)
+
+Returns the suffix of the C<$path>'s file name. If the C<$path> does not have a
+valid file name or if the file name has no suffix, C<undef> is returned
+instead.
+
+The suffix of a file name is essentially its extension, e.g.
+C</etc/resolv.conf> has the suffix C<conf>. If there are multiple suffixes,
+only the last will be returned; e.g. C</tmp/archive.tar.gz> has the suffix C<gz>.
+
+B<Note:> Files like e.g. C</tmp/foo.> have an empty string as suffix.
+
+For getting all suffixes of a path, see C<L<< path_file_suffixes()|/"path_file_suffixes($path)" >>>.
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_suffix : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ (undef, $file_name) = _path_file_prefix($file_name);
+
+ my @suffixes = _path_file_suffixes($file_name);
+
+ return pop(@suffixes);
+}
+
+=head3 path_with_file_suffix($path, $suffix)
+
+Returns C<$path> with a new C<$suffix>. This is similar to
+C<L<< path_with_file_suffixes()|/"path_with_file_suffixes($path, @suffixes)" >>>,
+except that only the last suffix of the file name is replaced.
+
+If the C<$path> does not have a file name, C<undef> is returned.
+
+ my $new_path = path_with_file_suffix("/tmp/archive.tar.zst", "gz");
+ # /tmp/archive.tar.gz
+
+If the file name has no suffixes, the C<$suffix> is appended instead:
+
+ my $new_path = path_with_file_suffix("/etc/resolv", "conf");
+ # /etc/resolv.conf
+
+If C<$suffix> is C<undef>, the file name's (last) suffix will be removed (if
+there is one):
+
+ my $new_path = path_with_file_suffix("/tmp/archive.tar.zst", undef);
+ # /tmp/archive.tar
+
+ my $new_path = path_with_file_suffix("/etc/resolv", undef);
+ # /etc/resolv
+
+Note that an empty string is still a valid suffix (an "empty" file ending):
+
+ my $new_path = path_with_file_suffix("/tmp/archive.tar.zst", "");
+ # /tmp/archive.tar.
+
+ my $new_path = path_with_file_suffix("/etc/resolv", "");
+ # /etc/resolv.
+
+Throws an exception if any of the arguments is C<undef>, or if C<$suffix>
+contains a path separator (C</>) or a C<.>.
+
+=cut
+
+sub path_with_file_suffix : prototype($$) {
+ my ($path, $suffix) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if (defined($suffix)) {
+ croak "\$suffix contains a path separator" if $suffix =~ m|/|;
+ croak "\$suffix contains a dot" if $suffix =~ m|\.|;
+ }
+
+ return undef if !defined(path_file_name($path));
+
+ my $parent = path_parent($path);
+
+ # sanity check -- should not happen because we checked for file name,
+ # and the existence of a file name implies there's a parent
+ confess "parent of \$path is undef" if !defined($parent);
+
+ my @suffixes = path_file_suffixes($path);
+
+ # Don't modify $path if there is no suffix to be removed
+ return $path if !scalar(@suffixes) && !defined($suffix);
+
+ pop(@suffixes);
+ push(@suffixes, $suffix) if defined($suffix);
+
+ my $prefix = path_file_prefix($path);
+
+ # sanity check
+ confess "\$prefix is undef" if !defined($prefix);
+
+ my $file_name = join(".", $prefix, @suffixes);
+
+ return path_push($parent, $file_name);
+}
+
+=head3 path_file_parts($path)
+
+Returns the parts that constitute the file name (prefix and suffixes) of a
+C<$path> as a list. If the C<$path> does not have a valid file name, an empty
+list is returned instead.
+
+In scalar context, returns a reference to a list.
+
+These parts are split in such a way that allows them to be C<join>ed together,
+resulting in the original file name of the given C<$path> again.
+
+ my $file_parts = path_file_parts("/etc/pve/firewall/cluster.fw");
+ # ("cluster", "fw")
+ my $file_name = join(".", $file_parts->@*);
+
+ my @file_parts = path_file_parts("/tmp/archive.tar.gz");
+ # ("archive", "tar", "gz")
+ my $file_name = join(".", @file_parts);
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_parts : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ if (!defined($file_name)) {
+ return wantarray ? () : [];
+ }
+
+ my $prefix;
+ ($prefix, $file_name) = _path_file_prefix($file_name);
+
+ my @suffixes = _path_file_suffixes($file_name);
+
+ my @file_parts = ($prefix, @suffixes);
+
+ return wantarray ? @file_parts : \@file_parts;
+}
+
+=head3 path_starts_with($path, $other_path)
+
+Checks whether a C<$path> starts with the components of C<$other_path>.
+
+ my $starts_with = path_starts_with("/etc/pve/firewall/cluster.fw", "/etc/pve");
+ # 1
+
+Throws an exception if any of the arguments is C<undef>.
+
+=cut
+
+sub path_starts_with : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing starts with nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing cannot start with something
+ # Something cannot start with nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components = path_components($path);
+ my @other_components = path_components($other_path);
+
+ my @pairs = zip_shortest(\@components, \@other_components);
+
+ # for my ($comp, $other_comp) (@pairs) is experimental
+ for my $pair (@pairs) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+=head3 path_ends_with($path, $other_path)
+
+Checks whether a C<$path> ends with the components of C<$other_path>.
+
+ my $ends_with = path_ends_with("/etc/pve/firewall/cluster.fw", "firewall/cluster.fw");
+ # 1
+
+Throws an exception if any of the arguments is C<undef>.
+
+=cut
+
+sub path_ends_with : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing ends with nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing cannot end with something
+ # Something cannot end with nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components_rev = reverse(path_components($path));
+ my @other_components_rev = reverse(path_components($other_path));
+
+ my @pairs_rev = zip_shortest(\@components_rev, \@other_components_rev);
+
+ # for my ($comp, $other_comp) (@pairs_rev) is experimental
+ for my $pair (@pairs_rev) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+=head3 path_equals($path, $other_path)
+
+Checks whether C<$path> equals C<$other_path>. The paths are compared
+by their components, meaning that it's not necessary to
+L<< normalize|/"path_normalize($path)" >> them beforehand.
+
+=cut
+
+sub path_equals : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing is nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing is not something
+ # Something is not nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components = path_components($path);
+ my @other_components = path_components($other_path);
+
+ return if scalar(@components) != scalar(@other_components);
+
+ my @pairs = zip_longest(\@components, \@other_components);
+
+ # for my ($comp, $other_comp) (@pairs_rev) is experimental
+ for my $pair (@pairs) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ return if !defined($comp) || !defined($other_comp);
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+1;
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 1/4] introduce PVE::Path Max Carrara
@ 2024-12-19 18:31 ` Max Carrara
2024-12-19 19:08 ` Thomas Lamprecht
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 3/4] introduce PVE::Filesystem Max Carrara
` (2 subsequent siblings)
4 siblings, 1 reply; 8+ messages in thread
From: Max Carrara @ 2024-12-19 18:31 UTC (permalink / raw)
To: pve-devel
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@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
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* [pve-devel] [PATCH v1 pve-common 3/4] introduce PVE::Filesystem
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 1/4] introduce PVE::Path Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path Max Carrara
@ 2024-12-19 18:31 ` Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 4/4] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
2024-12-20 18:55 ` [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
4 siblings, 0 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-19 18:31 UTC (permalink / raw)
To: pve-devel
The PVE::Filesystem module implements filesystem manipulation
operations. Currently, this is limited to two wrapper functions, but
in the future anything that concernts itself with altering the
filesystem should be added to it.
This module can be seen as the "complement" to PVE::Path -- while
PVE::Path doesn't ever alter the filesystem, PVE::Filesystem does, as
the name implies. This is done in order to clearly separate concerns.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
src/Makefile | 1 +
src/PVE/Filesystem.pm | 78 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 79 insertions(+)
create mode 100644 src/PVE/Filesystem.pm
diff --git a/src/Makefile b/src/Makefile
index 25bc490..20a0988 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -16,6 +16,7 @@ LIB_SOURCES = \
CpuSet.pm \
Daemon.pm \
Exception.pm \
+ Filesystem.pm \
Format.pm \
INotify.pm \
JSONSchema.pm \
diff --git a/src/PVE/Filesystem.pm b/src/PVE/Filesystem.pm
new file mode 100644
index 0000000..3b06634
--- /dev/null
+++ b/src/PVE/Filesystem.pm
@@ -0,0 +1,78 @@
+=head1 NAME
+
+C<PVE::Filesystem> - Utilities related to filesystem manipulations
+
+=head1 DESCRIPTION
+
+This module implements utilities for manipulating the filesystem. Like
+L<C<PVE::Path>>, this module exists to address certain shortcomings of the Perl
+core modules without relying on third-party solutions / abstractions.
+
+=cut
+
+package PVE::Filesystem;
+
+use strict;
+use warnings;
+
+use Carp qw(carp croak confess);
+use Cwd ();
+
+use Exporter qw(import);
+
+our @EXPORT_OK = qw(
+ fs_cwd
+ fs_canonicalize
+);
+
+=head2 FUNCTIONS
+
+=cut
+
+=head3 fs_getcwd()
+
+Wrapper for C<L<< getcwd()|Cwd/getcwd >>>.
+
+Returns the absolute form of the current working directory.
+
+Unlike the original C<L<< getcwd()|Cwd/getcwd >>>, an exception is thrown if an
+error occurs instead of setting C<$!>.
+
+=cut
+
+sub fs_getcwd : prototype() {
+ my $cwd = Cwd::getcwd();
+
+ croak "failed to get current working directory: $!" if !defined($cwd);
+
+ return $cwd;
+}
+
+=head3 fs_canonicalize($path)
+
+Wrapper for C<L<< abs_path()|Cwd/abs_path >>>.
+
+Returns the canonical, absolute form of the given path with all logical
+components normalized and symlinks resolved.
+
+B<Note:> This requires the path to exist on the filesystem. If you want to
+avoid that, use C<L<< path_normalize()|PVE::Path/"path_normalize($path)" >>>
+instead.
+
+Unlike the original C<L<< abs_path()|Cwd/abs_path >>>, an exception is thrown
+if an error occurs instead of setting C<$!>.
+
+=cut
+
+sub fs_canonicalize : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $canonicalized_path = Cwd::abs_path($path);
+
+ croak "failed to canonicalize path: $!" if !defined($canonicalized_path);
+
+ return $canonicalized_path;
+}
+
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* [pve-devel] [PATCH v1 pve-common 4/4] debian: introduce package libproxmox-fs-path-utils-perl
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (2 preceding siblings ...)
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 3/4] introduce PVE::Filesystem Max Carrara
@ 2024-12-19 18:31 ` Max Carrara
2024-12-20 18:55 ` [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
4 siblings, 0 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-19 18:31 UTC (permalink / raw)
To: pve-devel
This package contains both PVE::Path and PVE::Filesystem and is added
in order to split off those two modules from the rest of
libpve-common-perl from the get-go.
Both modules are provided in one package because chances are, if one
needs stuff from one module, they'll need stuff from the other module
too. Their functionality goes hand-in-hand.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
debian/control | 6 ++++
debian/libproxmox-fs-path-utils-perl.install | 2 ++
debian/libpve-common-perl.install | 29 ++++++++++++++++++++
3 files changed, 37 insertions(+)
create mode 100644 debian/libproxmox-fs-path-utils-perl.install
create mode 100644 debian/libpve-common-perl.install
diff --git a/debian/control b/debian/control
index ac4cd66..39dadb5 100644
--- a/debian/control
+++ b/debian/control
@@ -52,3 +52,9 @@ Breaks: ifupdown2 (<< 2.0.1-1+pve5),
qemu-server (<< 8.0.1),
Description: Proxmox VE base library
This package contains the base library used by other Proxmox VE components.
+
+Package: libproxmox-fs-path-utils-perl
+Architecture: all
+Depends: ${perl:Depends}
+Description: Proxmox Filesystem & Path Utilities
+ Utils for filesystem manipulation and file path operations.
diff --git a/debian/libproxmox-fs-path-utils-perl.install b/debian/libproxmox-fs-path-utils-perl.install
new file mode 100644
index 0000000..2a1a8ac
--- /dev/null
+++ b/debian/libproxmox-fs-path-utils-perl.install
@@ -0,0 +1,2 @@
+/usr/share/perl5/PVE/Filesystem.pm
+/usr/share/perl5/PVE/Path.pm
diff --git a/debian/libpve-common-perl.install b/debian/libpve-common-perl.install
new file mode 100644
index 0000000..2cd8b59
--- /dev/null
+++ b/debian/libpve-common-perl.install
@@ -0,0 +1,29 @@
+/usr/share/perl5/PVE/AtomicFile.pm
+/usr/share/perl5/PVE/CalendarEvent.pm
+/usr/share/perl5/PVE/Certificate.pm
+/usr/share/perl5/PVE/CGroup.pm
+/usr/share/perl5/PVE/CLIFormatter.pm
+/usr/share/perl5/PVE/CLIHandler.pm
+/usr/share/perl5/PVE/CpuSet.pm
+/usr/share/perl5/PVE/Daemon.pm
+/usr/share/perl5/PVE/Exception.pm
+/usr/share/perl5/PVE/Format.pm
+/usr/share/perl5/PVE/INotify.pm
+/usr/share/perl5/PVE/Job
+/usr/share/perl5/PVE/Job/Registry.pm
+/usr/share/perl5/PVE/JSONSchema.pm
+/usr/share/perl5/PVE/LDAP.pm
+/usr/share/perl5/PVE/Network.pm
+/usr/share/perl5/PVE/OTP.pm
+/usr/share/perl5/PVE/PBSClient.pm
+/usr/share/perl5/PVE/ProcFSTools.pm
+/usr/share/perl5/PVE/PTY.pm
+/usr/share/perl5/PVE/RESTEnvironment.pm
+/usr/share/perl5/PVE/RESTHandler.pm
+/usr/share/perl5/PVE/SafeSyslog.pm
+/usr/share/perl5/PVE/SectionConfig.pm
+/usr/share/perl5/PVE/Syscall.pm
+/usr/share/perl5/PVE/SysFSTools.pm
+/usr/share/perl5/PVE/Systemd.pm
+/usr/share/perl5/PVE/Ticket.pm
+/usr/share/perl5/PVE/Tools.pm
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path Max Carrara
@ 2024-12-19 19:08 ` Thomas Lamprecht
2024-12-20 11:06 ` Max Carrara
0 siblings, 1 reply; 8+ messages in thread
From: Thomas Lamprecht @ 2024-12-19 19:08 UTC (permalink / raw)
To: Proxmox VE development discussion, Max Carrara
Am 19.12.24 um 19:31 schrieb Max Carrara:
> 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.
IMO that's a little bit contradictory, as redundant tests, or not knowing
how much redundancy there is making me a bit question if this is really
worth it. I'd rather see much fewer tests but with a clear plan/idea for
what they are for; as of is this is not really reviewable and without
knowing how they got created and how much it was made sure that we do not
test ten times the same thing.
I do not want to say you do, but would like some more reasoning here than
"trust me bro" and if we can have 100, or even less, tests with the same
coverage it would be a big improvement, as that makes them much more
maintainable.
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path
2024-12-19 19:08 ` Thomas Lamprecht
@ 2024-12-20 11:06 ` Max Carrara
0 siblings, 0 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-20 11:06 UTC (permalink / raw)
To: Thomas Lamprecht, Proxmox VE development discussion
On Thu Dec 19, 2024 at 8:08 PM CET, Thomas Lamprecht wrote:
> Am 19.12.24 um 19:31 schrieb Max Carrara:
> > 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.
>
> IMO that's a little bit contradictory, as redundant tests, or not knowing
> how much redundancy there is making me a bit question if this is really
> worth it. I'd rather see much fewer tests but with a clear plan/idea for
> what they are for; as of is this is not really reviewable and without
> knowing how they got created and how much it was made sure that we do not
> test ten times the same thing.
>
> I do not want to say you do, but would like some more reasoning here than
> "trust me bro" and if we can have 100, or even less, tests with the same
> coverage it would be a big improvement, as that makes them much more
> maintainable.
Hmm, fair point. I'll see if I can slim down the amount of tests and
instead be really particular about what's being tested. I'll also split
this commit up into multiple smaller ones and explain my reasonings for
each.
There's of course an idea on how I'm testing things here, but I agree
that it should be laid out better (or perhaps actually be laid out in
the first place).
Thanks for your feedback, will address this in v2!
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (3 preceding siblings ...)
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 4/4] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
@ 2024-12-20 18:55 ` Max Carrara
4 siblings, 0 replies; 8+ messages in thread
From: Max Carrara @ 2024-12-20 18:55 UTC (permalink / raw)
To: Proxmox VE development discussion
On Thu Dec 19, 2024 at 7:31 PM CET, Max Carrara wrote:
> Introduce and Package PVE::Path & PVE::Filesystem
> =================================================
>
Superseded by: https://lore.proxmox.com/pve-devel/20241220185207.519912-1-m.carrara@proxmox.com/
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2024-12-20 18:55 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-12-19 18:31 [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 1/4] introduce PVE::Path Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 2/4] add tests for PVE::Path Max Carrara
2024-12-19 19:08 ` Thomas Lamprecht
2024-12-20 11:06 ` Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 3/4] introduce PVE::Filesystem Max Carrara
2024-12-19 18:31 ` [pve-devel] [PATCH v1 pve-common 4/4] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
2024-12-20 18:55 ` [pve-devel] [PATCH v1 pve-common 0/4] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox