* [pve-devel] [PATCH v4 pve-common 01/12] introduce PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 02/12] test: add directory for tests of PVE::Path module Max Carrara
` (10 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 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>
---
Changes v3 --> v4:
* Fix typo in docstring of `path_components` that caused building the
docs to fail.
- Thanks to Fiona for spotting that!
* Emit a warning on call sites of `path_join` in case an absolute path
is passed -- this should prevent any future accidents since passing
an abs path here is almost always an accident, but still keeps
the behaviour of `path_join` equivalent to Rust's `Path::join`
/ `PathBuf::push`.
- Thanks to Fiona for the suggestion!
* Emit a warning on call sites of `path_push`.
- The same reasons of the changes to `path_join` apply here also.
- Thanks to Fiona for the suggestion!
* Simplify the logic around abs paths in `path_join` since that
function isn't performance-critical anyway.
- Thanks to Fiona for the suggestion!
* Make eval-block in `path_normalize` more narrow and remove newline
between the block and the first usage of `$@`.
- Thanks to Fiona for the suggestion!
* Make `path_normalize` treat paths "foo" and "./foo" differently.
- I decided to deviate from Perl's `File::Spec->canonpath` here
because frankly, its behaviour there doesn't make that much sense
to me, after giving it some more thought. Functions like
`path_components` already take the leading curr. dir ref into
account and retain it (as do other libraries).
- While it might be true that "foo" and "./foo" technically mean the
same thing, sometimes you want to make it explicit that the path
is relative to the current directory.
- In other words, since this won't make an actual *logical*
difference, it *can* make a semantic difference, so let's deviate
from `canonpath` and make things simpler overall.
- tbh, `canonpath` doesn't care either way, and the rest of Perl
probably doesn't either.
* Make behaviour of `path_parent` identical to Rust's `Path::parent`.
- Previously, the parent of "./foo" and "foo" was both ".".
Now the parent of "./foo" is still ".", but the parent of "foo" is
now an empty string.
- This was the next logical step after making `path_normalize`
retain leading current dir references -- now it's actually
possible to have the same behaviour as `Path::parent`.
- This actually makes things a little more simple here and there.
- Thanks to Fiona for the suggestion!
* Remove handling of previous behaviour of `path_parent` where
applicable.
- This mostly just boils down to removing an extra case for relative
paths that begin with a current dir reference, like e.g. "./foo".
* Make `path_with_file_name` always append the new file name if the
original path didn't have one.
- This not only makes the behaviour similar to Rust's
`PathBuf::set_file_name`, but also makes the function behave more
consistently overall.
* Change behaviour of `path_file_prefix` to be more in line with
Rust's upcoming `Path::file_prefix` [prefix].
- This pretty much only effects paths like "/foo/bar/..baz.quo",
where previously "..baz" was considered the prefix, but now it's
just ".".
- In other words, everything before the second non-leading dot is
now the prefix.
- Docstrings across the other file op functions are updated in
accordance with this change.
* Check for non-leading dots in `path_with_file_prefix` instead of
checking for dots only at the end of prefixes.
* Mention how file names with a leading dot are treated in most file
op functions like `path_file_prefix`, `path_file_with_prefix`, etc. and
also provide an example for such cases.
- This just makes it more obvious for consumers of this module how
these functions work, leaving much less room for any ambiguities.
- Not all docstrings have been adapted here, only those of immediate
relevancy; some of the docstrings would otherwise get too large.
- Thanks to Fiona for the suggestion!
* Mention treatment of empty paths (literally just empty strings) in
the docstrings of `path_starts_with`, `path_ends_with` and
`path_equals`.
- Thanks to Fiona for the suggestion!
* Improve style here and there in minor parts of the code.
* Update docstrings for all changes above where applicable / relevant.
- Also fix some cases where docstrings were using a function than
the one being documented in examples (copy-paste errors)
* (Being extra detailed with the changes here because I want to make
it a little easier to merge this, so I hope I haven't forgotten
anything.)
[prefix]: https://doc.rust-lang.org/std/path/struct.Path.html#method.file_prefix
Changes v2 --> v3:
* Don't return a reference to a list anymore when path_components,
path_file_suffixes, path_file_parts are called in scalar context
* Mention '/' being added at the start of the components being
returned by path_components in its docstring
* Mention special case of how absolute paths are handled and refer to
path_push in path_join's docstring
* Check whether path is absolute after checking whether it's empty
instead of the other way around in path_push
* Rework private helper functions and make them a little more
efficient
Changes v1 --> v2:
* Improve some wording in the docstring of path_components
* Simplify some logic in path_parent and remove an unnecessary sanity
check
* Actually treat "foo" as "./foo" in path_parent as mentioned in the
docstring -- This means that path_parent("foo") now returns "."
instead of "".
* Adapt the path_with_file_* functions to the above accordingly, so
that e.g. path_with_file_name("foo", "bar") returns "bar" instead of
"./bar".
* Improve the "boolean" behaviour of path_is_absolute and
path_is_absolute and return 1 when true, but use an empty return
when false.
- An empty return means "undef" in scalar context and an empty list
in list context, so those functions will always return something
that's correctly truthy or falsy for Perl, regardless of context
src/Makefile | 1 +
src/PVE/Path.pm | 1027 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 1028 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..fa10375
--- /dev/null
+++ b/src/PVE/Path.pm
@@ -0,0 +1,1027 @@
+=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)
+
+Returns C<1> if C<$path> is absolute (starts with a C</>).
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_is_absolute : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if ($path =~ m#^/#) {
+ return 1;
+ }
+
+ return;
+}
+
+=head3 path_is_relative($path)
+
+Returns C<1> if 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>.
+
+=cut
+
+sub path_is_relative : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if ($path !~ m#^/#) {
+ return 1;
+ }
+
+ return;
+}
+
+=head3 path_components($path)
+
+Returns a list of the given C<$path>'s individual components.
+
+The C<$path> is normalized a little during the parse:
+
+=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.
+
+=item Absolute paths will retain a C</> at the beginning. This means that
+C</foo/bar> has 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;
+}
+
+
+=head3 path_join(@paths)
+
+Joins multiple paths together. All kinds of paths are supported.
+
+Does not perform any C<L<< normalization|/"path_normalize($path)" >>>.
+
+ my $joined = path_join("foo", "bar/baz", "qux.txt");
+ # foo/bar/baz/qux.txt
+
+ my $joined = path_join("/", "etc/pve/", "storage.cfg");
+ # /etc/pve/storage.cfg
+
+Similar to C<L<< path_push()|/"path_push($path, $other)">>>, should any of the
+C<@paths> be an absolute path, it I<replaces> all preceding paths while emitting
+a warning.
+
+ my $joined = path_join("foo/bar", "/etc", "resolv.conf");
+ # /etc/resolv.conf
+
+ my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
+ # /etc/hosts
+
+The reason for this behaviour is to stay consistent with Rust's
+C<L<< PathBuf::push()|https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.push >>>.
+
+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;
+
+ my $resulting_path = shift @paths;
+
+ for my $path (@paths) {
+ if ($path =~ m#^/#) {
+ carp "passed absolute path to path_join";
+ $resulting_path = $path;
+ } else {
+ $resulting_path = path_push($resulting_path, $path);
+ }
+ }
+
+ return $resulting_path;
+}
+
+=head3 path_normalize($path)
+
+Performs a logical cleanup of the given C<$path>.
+
+This removes unnecessary components of a path that can be safely removed, such
+as references to the current directory C<.>, trailing or repeated occurrences
+of path separators C</>.
+
+For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
+C<foo/bar/baz>.
+
+B<Difference to C<L<File::Spec/canonpath>>:> If the C<$path> starts by
+referencing the current directory C<.>, this reference is preserved, unless
+either C<.> or C<..> is the only component left after normalizing. This means
+that C<././foo///bar> will become C<./foo/bar>, and C<././.> will become C<.>.
+
+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 wrapped 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 $@;
+
+ if ($cleaned_path =~ m#^[^\./]# && $path =~ m#^\./#) {
+ $cleaned_path = "./" . $cleaned_path;
+ }
+
+ 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 identical to Rust's
+L<< Path::parent|https://doc.rust-lang.org/std/path/struct.Path.html#method.parent >>.
+
+=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>. Note that C<foo/bar> is not
+necessarily the real parent in the filesystem in the case of e.g. symlinks.
+
+=item * C<foo/../bar> becomes C<foo/..>.
+
+=item * C</> and an I<empty string> result in C<undef> being returned.
+
+=item * Paths consisting of a single component, like C<foo>, C<..> or C<.> result
+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);
+
+ # We had a root dir with needless extra components, e.g. "//" or "////" or "//.///./" etc.
+ return if $final_component eq '';
+
+ # We had a current dir reference with needless extra components, e.g.
+ # "././" or ".///////" or "./././//./././//" etc.
+ return '' if $final_component eq '.';
+
+ # We had some other kind of single component like "foo", "bar" or "..",
+ # so return an empty string
+ return '' if !scalar(@components);
+
+ # 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 while also emitting a
+warning. The reason for this behaviour is to stay consistent with Rust's
+C<L<< PathBuf::push()|https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.push >>>.
+
+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 $path if $other eq '';
+
+ if (path_is_absolute($other)) {
+ carp "passed absolute path to path_push";
+ return $other;
+ }
+
+ 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.
+
+If C<L<< path_file_name()|/"path_file_name($path)" >>> returns C<undef>, this is
+equivalent to calling C<L<< path_push($path, $file_name)|/"path_push($path, $other)" >>>.
+
+Otherwise, this is equivalent to calling C<L<< path_parent()|/"path_parent($path)" >>>
+and using C<L<< path_push()|/"path_push($path, $other)" >>> to append the new
+file name. In other words, the new path will have the same parent as the old one.
+
+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 $old_file_name = path_file_name($path);
+
+ if (!defined($old_file_name)) {
+ return path_push($path, $file_name);
+ }
+
+ my $parent = path_parent($path);
+
+ # undef means that $path was either "" or "/", so we can just append to it
+ # Should never be hitting this case, but remaining defensive here nevertheless
+ return ($path . $file_name) if !defined($parent);
+
+ return path_push($parent, $file_name);
+}
+
+# Note: This assumes that $file_name is in fact a valid file name, as returned
+# by path_file_name
+my sub _path_file_prefix_suffix_str : prototype($) {
+ my ($file_name) = @_;
+
+ confess "failed to match for \$prefix and \$suffir_str"
+ if $file_name !~ m|^(\.?[^\.]*)(.*)|;
+
+ my ($prefix, $suffix_str) = ($1, $2);
+
+ return ($prefix, $suffix_str);
+}
+
+# Note: This assumes that $suffix_str isn't undef
+my sub _path_file_suffixes_from_str : prototype($) {
+ my ($suffix_str) = @_;
+
+ my @suffixes = split(/\./, $suffix_str, -1);
+
+ # Let's say you have a file named "foo.bar.". $suffix_str would be ".bar.";
+ # so with the call to split() above, you get the following:
+ # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar."
+ # Hence, shift() the first element away to get only the actual suffixes,
+ # allowing prefix and suffixes to be join()ed to restore the original file name.
+ shift @suffixes;
+
+ return @suffixes;
+}
+
+=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
+
+ my $prefix = path_file_prefix("/home/alice/.zshrc.bak");
+ # .zshrc
+
+In detail, this means that the prefix is:
+
+=over
+
+=item * C<undef>, if there is no file name
+
+=item * The entire file name if there is no embedded C<.>
+
+=item * The part of the file name before the first non-beginning C<.>
+
+=item * The entire file name if the file begins with C<.> and has no other C<.>s within
+
+=item * The part of the file name before the second C<.> if the file begins with C<.>
+
+=back
+
+This is equivalent to Rust's C<L<< Path::file_prefix()|https://doc.rust-lang.org/std/path/struct.Path.html#method.file_prefix >>>.
+
+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, $_suffix_str) = _path_file_prefix_suffix_str($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.
+
+If C<$path> does not have a file name, C<undef> is returned instead.
+
+ 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
+
+ my $new_path = path_with_file_prefix("/home/alice/.zshrc.bak", ".bashrc");
+ # /home/alice/.bashrc.bak
+
+Throws an exception if any of the arguments is C<undef>, or if C<$prefix>
+contains a path separator (C</>) or a non-leading C<.>.
+
+=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 contains non-leading dot" if $prefix !~ m|^\.?[^\.]*$|;
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ 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 ($_old_prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+
+ my $new_file_name = $prefix . $suffix_str;
+
+ return path_push($parent, $new_file_name);
+}
+
+=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.
+
+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_suffixes("/tmp/archive.tar.zst");
+ # ("tar", "zst")
+
+ my @suffixes = path_file_suffixes("/home/alice/.zshrc");
+ # ()
+
+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 ();
+ }
+
+ my ($_prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+
+ return _path_file_suffixes_from_str($suffix_str);
+}
+
+=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;
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ 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 ($prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+
+ # Don't modify $path if there are no suffixes to be removed
+ return $path if !scalar(@suffixes) && $suffix_str eq '';
+
+ # sanity check
+ confess "\$prefix is undef" if !defined($prefix);
+
+ my $new_file_name = join(".", $prefix, @suffixes);
+
+ return path_push($parent, $new_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 C<""> as suffix.
+
+ my $suffix = path_file_suffix("/etc/resolv.conf");
+ # "conf"
+
+ my $suffix = path_file_suffix("/tmp/archive.tar.zst");
+ # "zst"
+
+ my $suffix = path_file_suffix("/home/alice/.zshrc");
+ # undef
+
+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);
+
+ my ($_prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+ my @suffixes = _path_file_suffixes_from_str($suffix_str);
+
+ 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 C<$path> 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|\.|;
+ }
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ 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 ($prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+ my @suffixes = _path_file_suffixes_from_str($suffix_str);
+
+ # 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);
+
+ # sanity check
+ confess "\$prefix is undef" if !defined($prefix);
+
+ my $new_file_name = join(".", $prefix, @suffixes);
+
+ # Because the parent of "foo" is ".", return $new_file_name to stay consistent.
+ # Otherwise, we'd end up with a current path ref prepended ("./$new_file_name")
+ # (Done also in path_with_new_file_name)
+ if ($parent eq '.' && $path !~ m|/|) {
+ return $new_file_name;
+ }
+
+ return path_push($parent, $new_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.
+
+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")
+
+ # Parts can be joined to acquire the original file name again
+ my $file_name = join(".", @file_parts);
+
+ my @file_parts = path_file_parts("/tmp/archive.tar.gz");
+ # ("archive", "tar", "gz")
+
+ my @file_parts = path_file_parts("/home/alice/.zshrc.bak");
+ # (".zshrc", "bak")
+
+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 ();
+ }
+
+ my ($prefix, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+ my @suffixes = _path_file_suffixes_from_str($suffix_str);
+
+ return ($prefix, @suffixes);
+}
+
+=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
+
+Since the paths are compared by their components, it's not necessary to
+L<< normalize|"path_normalize($path)" >> them beforehand.
+
+Additionally, if both paths are empty paths (C<"">), C<$path> is considered to
+start with C<$other_path> and vice versa. If instead only one path is empty,
+neither starts with the other.
+
+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
+
+Since the paths are compared by their components, it's not necessary to
+L<< normalize|"path_normalize($path)" >> them beforehand.
+
+Additionally, if both paths are empty paths (C<"">), C<$path> is considered to
+end with C<$other_path> and vice versa. If instead only one path is empty,
+neither ends with the other.
+
+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.
+
+If both of the paths are empty (C<"">), they're considered equal.
+If only one of the two paths is empty, they're not considered equal.
+
+=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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 02/12] test: add directory for tests of PVE::Path module
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 01/12] introduce PVE::Path Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 03/12] test: add tests for path_is_absolute and path_is_relative of PVE::Path Max Carrara
` (9 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Add the test/Path directory as well as test/Path/Makefile, containing
the scaffolding for tests regarding PVE::Path.
Include test/Path as subdirectory in test/Makefile, so
test/Path/Makefile runs when the other tests run, too.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* None
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Makefile | 5 ++++-
test/Path/Makefile | 16 ++++++++++++++++
2 files changed, 20 insertions(+), 1 deletion(-)
create mode 100644 test/Path/Makefile
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..d091036
--- /dev/null
+++ b/test/Path/Makefile
@@ -0,0 +1,16 @@
+TESTS = \
+
+
+TEST_TARGETS = $(addsuffix .t,$(basename ${TESTS}))
+
+all:
+
+.PHONY: check
+
+check: ${TEST_TARGETS}
+
+%.t: %.pl
+ ./$<
+
+distclean: clean
+clean:
--
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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 03/12] test: add tests for path_is_absolute and path_is_relative of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 01/12] introduce PVE::Path Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 02/12] test: add directory for tests of PVE::Path module Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 04/12] test: add tests for path_components " Max Carrara
` (8 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Add cases for both functions, as they're each other's opposite.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* None
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_is_absolute_relative_tests.pl | 122 +++++++++++++++++++
2 files changed, 123 insertions(+)
create mode 100755 test/Path/path_is_absolute_relative_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index d091036..5998c19 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,4 +1,5 @@
TESTS = \
+ path_is_absolute_relative_tests.pl \
TEST_TARGETS = $(addsuffix .t,$(basename ${TESTS}))
diff --git a/test/Path/path_is_absolute_relative_tests.pl b/test/Path/path_is_absolute_relative_tests.pl
new file mode 100755
index 0000000..ad36c11
--- /dev/null
+++ b/test/Path/path_is_absolute_relative_tests.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_is_absolute_relative_cases = [
+ {
+ name => "empty path",
+ path => "",
+ is_absolute => undef,
+ is_relative => 1,
+ },
+ {
+ name => "root",
+ path => "/",
+ is_absolute => 1,
+ is_relative => undef,
+ },
+ {
+ name => "single component, relative",
+ path => "foo",
+ is_absolute => undef,
+ is_relative => 1,
+ },
+ {
+ name => "single component, absolute",
+ path => "/foo",
+ is_absolute => 1,
+ is_relative => undef,
+ },
+ {
+ name => "path is undef",
+ path => undef,
+ is_absolute => undef,
+ is_relative => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_is_absolute : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_is_absolute: " . $case->{name};
+
+ my $is_absolute = eval { PVE::Path::path_is_absolute($case->{path}); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ 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_absolute, $case->{is_absolute}, $name)) {
+ diag("path = " . $case->{path});
+ }
+
+ return;
+}
+
+sub test_path_is_relative : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_is_relative: " . $case->{name};
+
+ my $is_relative = eval { PVE::Path::path_is_relative($case->{path}); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ 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_relative, $case->{is_relative}, $name)) {
+ diag("path = " . $case->{path});
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_is_absolute,
+ \&test_path_is_relative,
+ ];
+
+ plan(tests => scalar($path_is_absolute_relative_cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($path_is_absolute_relative_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 $@;
+ }
+ }
+
+ 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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 04/12] test: add tests for path_components of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (2 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 03/12] test: add tests for path_is_absolute and path_is_relative of PVE::Path Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 05/12] test: add tests for path_join " Max Carrara
` (7 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* None
Changes v2 --> v3:
* Adapt code accordingly since path_components doesn't return a list
ref in scalar context anymore
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_components_tests.pl | 162 +++++++++++++++++++++++++++++
2 files changed, 163 insertions(+)
create mode 100755 test/Path/path_components_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 5998c19..3f48a38 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,4 +1,5 @@
TESTS = \
+ path_components_tests.pl \
path_is_absolute_relative_tests.pl \
diff --git a/test/Path/path_components_tests.pl b/test/Path/path_components_tests.pl
new file mode 100755
index 0000000..cbbbc22
--- /dev/null
+++ b/test/Path/path_components_tests.pl
@@ -0,0 +1,162 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_components_cases = [
+ {
+ name => "empty path",
+ path => "",
+ components => [],
+ },
+ {
+ name => "root",
+ path => "/",
+ components => ["/"],
+ },
+ {
+ name => "current path reference",
+ path => ".",
+ components => ["."],
+ },
+ {
+ name => "parent directory reference",
+ path => "..",
+ components => [".."],
+ },
+ {
+ name => "single component, relative",
+ path => "foo",
+ components => ["foo"],
+ },
+ {
+ name => "single component, absolute",
+ path => "/foo",
+ components => ["/", "foo"],
+ },
+ {
+ name => "multiple components, relative",
+ path => "foo/bar/baz/quo/qux",
+ components => ["foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components, absolute",
+ path => "/foo/bar/baz/quo/qux",
+ components => ["/", "foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components,"
+ . " starting with current path reference,"
+ . " with redundant current path references",
+ path => "././foo/./bar/././baz/./././quo/././././qux/./.",
+ components => [".", "foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "multiple components, with parent directory references",
+ path => "../../foo/../bar/../../baz/../../../quo/../../../../qux/../..",
+ components => [
+ "..", "..", "foo",
+ "..", "bar",
+ "..", "..", "baz",
+ "..", "..", "..", "quo",
+ "..", "..", "..", "..", "qux",
+ "..", "..",
+ ],
+ },
+ {
+ name => "multiple components, with redundant path separators",
+ path => "foo//bar///baz////quo/////qux//////",
+ components => ["foo", "bar", "baz", "quo", "qux"],
+ },
+ {
+ name => "root path, with redundant path separators",
+ path => "//////////",
+ components => ["/"],
+ },
+ {
+ name => "root path, with redundant current path references",
+ path => "/./././././././.",
+ components => ["/"],
+ },
+ {
+ name => "current path reference, with redundant path separators",
+ path => ".//////////",
+ components => ["."],
+ },
+ {
+ name => "current path reference, with redundant current path references",
+ path => "././././././././.",
+ components => ["."],
+ },
+ {
+ name => "multiple components,"
+ . " absolute,"
+ . " with redundant path separators,"
+ . " with redundant current path references,"
+ . " with parent directory references",
+ path => "///././//foo//.//bar////././//.///baz//..///.././quo/./.././/qux//././/",
+ components => ["/", "foo", "bar", "baz", "..", "..", "quo", "..", "qux"],
+ },
+ {
+ name => "path is undef",
+ path => undef,
+ components => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_components : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_components: " . $case->{name};
+
+ my $components = eval {
+ my @comps = PVE::Path::path_components($case->{path});
+ \@comps;
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ 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 main : prototype() {
+ plan(tests => scalar($path_components_cases->@*));
+
+ for my $case ($path_components_cases->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ test_path_components($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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 05/12] test: add tests for path_join of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (3 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 04/12] test: add tests for path_components " Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 06/12] test: add tests for path_push " Max Carrara
` (6 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Add not just tests for the path_join function alone, but also a
separate test subroutine that checks whether a joined path remains the
same after splitting (with path_components) and joining it a second
time.
Because the path doesn't strictly have to be the *same string* after
it is split and joined a second time (it only has to be *logically*),
normalize both the re-joined and the expected path before comparison.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* Adapt test cases for changes to patch 01 where applicable
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_join_tests.pl | 310 +++++++++++++++++++++++++++++++++++
2 files changed, 311 insertions(+)
create mode 100755 test/Path/path_join_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 3f48a38..08d34ac 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,6 +1,7 @@
TESTS = \
path_components_tests.pl \
path_is_absolute_relative_tests.pl \
+ path_join_tests.pl \
TEST_TARGETS = $(addsuffix .t,$(basename ${TESTS}))
diff --git a/test/Path/path_join_tests.pl b/test/Path/path_join_tests.pl
new file mode 100755
index 0000000..e6548fb
--- /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
+ 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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 06/12] test: add tests for path_push of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (4 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 05/12] test: add tests for path_join " Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 07/12] test: add tests for path_parent " Max Carrara
` (5 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* Adapt test cases for changes to patch 01 where applicable
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_push_tests.pl | 159 +++++++++++++++++++++++++++++++++++
2 files changed, 160 insertions(+)
create mode 100755 test/Path/path_push_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 08d34ac..9dd95f1 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -2,6 +2,7 @@ TESTS = \
path_components_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
+ path_push_tests.pl \
TEST_TARGETS = $(addsuffix .t,$(basename ${TESTS}))
diff --git a/test/Path/path_push_tests.pl b/test/Path/path_push_tests.pl
new file mode 100755
index 0000000..4d9d779
--- /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
+ 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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 07/12] test: add tests for path_parent of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (5 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 06/12] test: add tests for path_push " Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 08/12] test: add tests for path_starts_with, path_ends_with, path_equals Max Carrara
` (4 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* Adapt test cases for changes to patch 01 where applicable
* Remove description of commit message, as it is no longer necessary,
due to the changes made to `path_parent`
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_parent_tests.pl | 160 +++++++++++++++++++++++++++++++++
2 files changed, 161 insertions(+)
create mode 100755 test/Path/path_parent_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 9dd95f1..a2b5bb1 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -2,6 +2,7 @@ TESTS = \
path_components_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
+ path_parent_tests.pl \
path_push_tests.pl \
diff --git a/test/Path/path_parent_tests.pl b/test/Path/path_parent_tests.pl
new file mode 100755
index 0000000..7095c12
--- /dev/null
+++ b/test/Path/path_parent_tests.pl
@@ -0,0 +1,160 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_parent_cases = [
+ {
+ name => "empty path",
+ path => "",
+ parent => undef,
+ },
+ {
+ name => "root",
+ path => "/",
+ parent => undef,
+ },
+ {
+ name => "current path reference",
+ path => ".",
+ parent => "",
+ },
+ {
+ name => "single component, relative",
+ path => "foo",
+ parent => "",
+ },
+ {
+ name => "single component, relative, starting with current directory reference",
+ path => "./foo",
+ parent => ".",
+ },
+ {
+ name => "parent directory reference",
+ path => "..",
+ parent => "",
+ },
+ {
+ name => "single component, absolute",
+ path => "/foo",
+ parent => "/",
+ },
+ {
+ name => "multiple components, relative",
+ path => "foo/bar/baz/quo/qux",
+ parent => "foo/bar/baz/quo",
+ },
+ {
+ name => "multiple components, relative, starting with current directory reference",
+ path => "./foo/bar/baz",
+ parent => "./foo/bar",
+ },
+ {
+ name => "multiple components, absolute",
+ path => "/foo/bar/baz/quo/qux",
+ parent => "/foo/bar/baz/quo",
+ },
+ {
+ name => "multiple components, with redundant current path references",
+ path => "foo/bar/./baz/././quo/./././qux/././.",
+ parent => "foo/bar/./baz/././quo",
+ },
+ {
+ name => "multiple components, with parent directory references",
+ path => "foo/bar/../baz/../../quo/../../../qux/../../..",
+ parent => "foo/bar/../baz/../../quo/../../../qux/../..",
+ },
+ {
+ name => "multiple components, with redundant path separators",
+ path => "foo//bar///baz////quo/////qux//////",
+ parent => "foo//bar///baz////quo",
+ },
+ {
+ name => "root path, with redundant path separators",
+ path => "///////////",
+ parent => undef,
+ },
+ {
+ name => "root path, with redundant current path references",
+ path => "/././././././././././.",
+ parent => undef,
+ },
+ {
+ name => "current path reference, with redundant path separators",
+ path => ".///////////",
+ parent => "",
+ },
+ {
+ name => "current path reference, with redundant current path references",
+ path => "././././././././././.",
+ parent => "",
+ },
+ {
+ name => "multiple components,"
+ . " with redundant path separators,"
+ . " with redundant current path references",
+ path => "foo/.///./bar//././////././/baz//././///././././///",
+ parent => "foo/.///./bar",
+ },
+ {
+ name => "path is undef",
+ path => undef,
+ parent => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_parent : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_parent: " . $case->{name};
+
+ my $parent = eval { PVE::Path::path_parent($case->{path}); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ 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() {
+ plan(tests => scalar($path_parent_cases->@*));
+
+ for my $case ($path_parent_cases->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ test_path_parent($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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 08/12] test: add tests for path_starts_with, path_ends_with, path_equals
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (6 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 07/12] test: add tests for path_parent " Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 09/12] test: add tests for file path operation functions of PVE::Path Max Carrara
` (3 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
.. of PVE::Path.
Each function has its test cases defined separately to avoid running
unnecessary tests / repeating equivalent tests for certain things.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* None
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_comparison_tests.pl | 851 +++++++++++++++++++++++++++++
2 files changed, 852 insertions(+)
create mode 100755 test/Path/path_comparison_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index a2b5bb1..627dc09 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,4 +1,5 @@
TESTS = \
+ path_comparison_tests.pl \
path_components_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
diff --git a/test/Path/path_comparison_tests.pl b/test/Path/path_comparison_tests.pl
new file mode 100755
index 0000000..928edc1
--- /dev/null
+++ b/test/Path/path_comparison_tests.pl
@@ -0,0 +1,851 @@
+#!/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)) {
+ 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)) {
+ 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)) {
+ 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();
--
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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 09/12] test: add tests for file path operation functions of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (7 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 08/12] test: add tests for path_starts_with, path_ends_with, path_equals Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 10/12] test: add tests for path_normalize " Max Carrara
` (2 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Add tests for the functions path_file_name, path_file_prefix,
path_file_suffix and path_file_suffixes as well as their path_with_*
counterparts.
The cases defined here are a bit more elaborate than the others,
because manipulating file names specifically is more insidious as one
might think at first.
For example, getting the suffix of a file like /etc/resolv.conf is
rather trivial, as one can e.g. just take the last component and split
it at the dot, but for files like /foo/bar/...oh...no.. (yes, this has
a valid file name) it's much more tricker and can't actually be
performed via Perl's inbuilt split function alone.
That's why some of the cases added here account for weird file names,
files with more than two suffixes, etc. The functions above must of
course always work in a consistent manner, even if a file starts with
leading dots or has an arbitrarily high number of suffixes.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* Adapt test cases for changes to patch 01 where applicable
* Minor rewording of commit message
Changes v2 --> v3:
* Adapt code accordingly since path_file_suffixes and path_file_parts
don't return a list ref in scalar context anymore
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_file_ops_tests.pl | 1221 ++++++++++++++++++++++++++++++
2 files changed, 1222 insertions(+)
create mode 100755 test/Path/path_file_ops_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 627dc09..9dcb878 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,6 +1,7 @@
TESTS = \
path_comparison_tests.pl \
path_components_tests.pl \
+ path_file_ops_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
path_parent_tests.pl \
diff --git a/test/Path/path_file_ops_tests.pl b/test/Path/path_file_ops_tests.pl
new file mode 100755
index 0000000..7888f47
--- /dev/null
+++ b/test/Path/path_file_ops_tests.pl
@@ -0,0 +1,1221 @@
+#!/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 => ".",
+ file_suffix => "foobar",
+ file_suffixes => ["foobar"],
+ 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 => ".",
+ file_suffix => "",
+ file_suffixes => ["", "foo", "", "", "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 => "",
+ file_suffixes => ["", "", "", "", ""],
+ file_parts => [".", "", "", "", "", ""],
+ },
+ {
+ name => "/home/bob/. - current path reference",
+ path => "/home/bob/.",
+ file_name => "bob",
+ file_prefix => "bob",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["bob"],
+ },
+ {
+ name => "/home/bob/.. - parent path reference",
+ path => "/home/bob/..",
+ file_name => undef,
+ file_prefix => undef,
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => [],
+ },
+];
+
+sub test_path_file_name : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_name: " . $case->{name};
+
+ my $file_name = eval { PVE::Path::path_file_name($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file name of path:\n$@");
+ return;
+ }
+
+ if (!is($file_name, $case->{file_name}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_name}));
+ diag("=== Got ===");
+ diag(explain($file_name));
+ }
+
+ return;
+}
+
+sub test_path_file_prefix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_prefix: " . $case->{name};
+
+ my $file_prefix = eval { PVE::Path::path_file_prefix($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file prefix of path:\n$@");
+ return;
+ }
+
+ if (!is($file_prefix, $case->{file_prefix}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_prefix}));
+ diag("=== Got ===");
+ diag(explain($file_prefix));
+ }
+
+ return;
+}
+
+sub test_path_file_suffix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_suffix: " . $case->{name};
+
+ my $file_suffix = eval { PVE::Path::path_file_suffix($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file suffix of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_suffix, $case->{file_suffix}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_suffix}));
+ diag("=== Got ===");
+ diag(explain($file_suffix));
+ }
+
+ return;
+}
+
+sub test_path_file_suffixes : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_suffixes: " . $case->{name};
+
+ my $file_suffixes = eval {
+ my @suffixes = PVE::Path::path_file_suffixes($case->{path});
+ \@suffixes;
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file suffixes of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_suffixes, $case->{file_suffixes}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_suffixes}));
+ diag("=== Got ===");
+ diag(explain($file_suffixes));
+ }
+
+ return;
+}
+
+sub test_path_file_parts : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_parts: " . $case->{name};
+
+ my $file_parts = eval {
+ my @parts = PVE::Path::path_file_parts($case->{path});
+ \@parts;
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file parts of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_parts, $case->{file_parts}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_parts}));
+ diag("=== Got ===");
+ diag(explain($file_parts));
+ }
+
+ return;
+}
+
+my $path_with_file_name_cases = [
+ {
+ name => "no path, no file name",
+ path => "",
+ file_name => "",
+ expected => "",
+ },
+ {
+ name => "root, no file name",
+ path => "/",
+ file_name => "",
+ expected => "/",
+ },
+ {
+ name => "no path, file name",
+ path => "",
+ file_name => "foo",
+ expected => "foo",
+ },
+ {
+ name => "root, file name",
+ path => "/",
+ file_name => "foo",
+ expected => "/foo",
+ },
+ {
+ name => "single path component, no file name",
+ path => "foo",
+ file_name => "",
+ expected => "",
+ },
+ {
+ name => "single path component, absolute, no file name",
+ path => "/foo",
+ file_name => "",
+ expected => "/",
+ },
+ {
+ name => "single path component, file name",
+ path => "foo",
+ file_name => "bar",
+ expected => "bar",
+ },
+ {
+ name => "single path component, absolute, file name",
+ path => "/foo",
+ file_name => "bar",
+ expected => "/bar",
+ },
+ {
+ name => "multiple path components, no file name",
+ path => "foo/bar/baz",
+ file_name => "",
+ expected => "foo/bar",
+ },
+ {
+ name => "multiple path components, absolute, no file name",
+ path => "/foo/bar/baz",
+ file_name => "",
+ expected => "/foo/bar",
+ },
+ {
+ name => "multiple path components, file name",
+ path => "foo/bar/baz",
+ file_name => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components, absolute, file name",
+ path => "/foo/bar/baz",
+ file_name => "qux",
+ expected => "/foo/bar/qux",
+ },
+ {
+ name => "multiple path components with current path reference, no file name",
+ path => "foo/bar/baz/.",
+ file_name => "",
+ expected => "foo/bar",
+ },
+ {
+ name => "multiple path components with current path reference, file name",
+ path => "foo/bar/baz/.",
+ file_name => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components with parent path reference, no file name",
+ path => "foo/bar/baz/..",
+ file_name => "",
+ expected => "foo/bar/baz/..",
+ },
+ {
+ name => "multiple path components with parent path reference, file name",
+ path => "foo/bar/baz/..",
+ file_name => "qux",
+ expected => "foo/bar/baz/../qux",
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/bar.txt",
+ path => "/home/bob/foo.txt",
+ file_name => "bar.txt",
+ expected => "/home/bob/bar.txt",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/backup.tar.zst",
+ path => "/tmp/archive.tar.gz",
+ file_name => "backup.tar.zst",
+ expected => "/tmp/backup.tar.zst",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...bar.csv",
+ path => "/home/bob/...foo.txt",
+ file_name => "...bar.csv",
+ expected => "/home/bob/...bar.csv",
+ },
+ {
+ name => "file name with path separator",
+ path => "foo/bar/baz",
+ file_name => "quo/qux",
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_name : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_name: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_name($case->{path}, $case->{file_name});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file name of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+my $path_with_file_prefix_cases = [
+ {
+ name => "no path, no prefix",
+ path => "",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "root, no prefix",
+ path => "/",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "no path, prefix",
+ path => "",
+ prefix => "foo",
+ expected => undef,
+ },
+ {
+ name => "root, prefix",
+ path => "/",
+ prefix => "foo",
+ expected => undef,
+ },
+ {
+ name => "single path component, no prefix",
+ path => "foo",
+ prefix => "",
+ expected => "",
+ },
+ {
+ name => "single path component, absolute, no prefix",
+ path => "/foo",
+ prefix => "",
+ expected => "/",
+ },
+ {
+ 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 => "foo/bar",
+ },
+ {
+ name => "multiple path components, absolute, no prefix",
+ path => "/foo/bar/baz",
+ prefix => "",
+ expected => "/foo/bar",
+ },
+ {
+ 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 => "foo/bar",
+ },
+ {
+ 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 => "prefix with leading dot",
+ path => "/home/alice/ssh",
+ prefix => ".ssh",
+ expected => "/home/alice/.ssh",
+ },
+ {
+ name => "prefix with path separator",
+ path => "foo/bar/baz",
+ prefix => "quo/qux",
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "prefix contains non-leading dot",
+ 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/.zshrc --> /home/bob/.zshrc.bak",
+ path => "/home/bob/.zshrc",
+ suffix => "bak",
+ expected => "/home/bob/.zshrc.bak",
+ },
+ {
+ name => "/home/bob/..foo --> /home/bob/..bar",
+ path => "/home/bob/..foo",
+ suffix => "bar",
+ expected => "/home/bob/..bar",
+ },
+ {
+ 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/...bar",
+ path => "/home/bob/...foo",
+ suffix => "bar",
+ expected => "/home/bob/...bar",
+ },
+ {
+ name => "/home/bob/...foo. --> /home/bob/...foo.txt",
+ path => "/home/bob/...foo.",
+ suffix => "txt",
+ expected => "/home/bob/...foo.txt",
+ },
+ {
+ 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/...foo...bar...baz",
+ path => "/home/bob/...one...two...three",
+ suffixes => ["", "foo", "", "", "bar", "", "", "baz"],
+ expected => "/home/bob/...foo...bar...baz",
+ },
+ {
+ name => "suffixes contain a path separator",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "oh/no", "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "suffixes contain a dot",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "oh.no", "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "suffixes contain undef",
+ path => "foo/bar/baz",
+ suffixes => ["tar", undef, "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_suffixes : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_suffixes: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_suffixes($case->{path}, $case->{suffixes}->@*);
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file suffixes of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $file_part_test_subs = [
+ \&test_path_file_name,
+ \&test_path_file_prefix,
+ \&test_path_file_suffix,
+ \&test_path_file_suffixes,
+ \&test_path_file_parts,
+ ];
+
+ plan(
+ tests => scalar($path_file_part_cases->@*) * scalar($file_part_test_subs->@*)
+ + scalar($path_with_file_name_cases->@*)
+ + scalar($path_with_file_prefix_cases->@*)
+ + scalar($path_with_file_suffix_cases->@*)
+ + scalar($path_with_file_suffixes_cases->@*)
+ );
+
+ for my $case ($path_file_part_cases->@*) {
+ for my $test_sub ($file_part_test_subs->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ $test_sub->($case);
+ };
+ warn "$@\n" if $@;
+ }
+ }
+
+ for my $case ($path_with_file_name_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_name($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_prefix_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_prefix($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_suffix_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_suffix($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_suffixes_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_suffixes($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 10/12] test: add tests for path_normalize of PVE::Path
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (8 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 09/12] test: add tests for file path operation functions of PVE::Path Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 11/12] introduce PVE::Filesystem Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 UTC (permalink / raw)
To: pve-devel
Add these tests solely to ensure that the behaviour of path_normalize
stays consistent / stable in case we ever decide to provide our own
implementation instead of partially wrapping `File::Spec->canonpath()`.
These tests also account for any deviations to `canonpath()`.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v3 --> v4:
* Adapt test cases for changes to patch 01 where applicable
* Minor rewording of commit message
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_normalize_tests.pl | 189 ++++++++++++++++++++++++++++++
2 files changed, 190 insertions(+)
create mode 100755 test/Path/path_normalize_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 9dcb878..8afed17 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -4,6 +4,7 @@ TESTS = \
path_file_ops_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
+ path_normalize_tests.pl \
path_parent_tests.pl \
path_push_tests.pl \
diff --git a/test/Path/path_normalize_tests.pl b/test/Path/path_normalize_tests.pl
new file mode 100755
index 0000000..f1555dc
--- /dev/null
+++ b/test/Path/path_normalize_tests.pl
@@ -0,0 +1,189 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+# Note: These tests exist solely to ensure that the behaviour of path_normalize
+# stays consistent in case we ever decide to provide our own implementation
+# instead of wrapping File::Spec->canonpath().
+
+my $path_normalize_cases = [
+ {
+ name => "empty path",
+ path => "",
+ normalized => "",
+ },
+ {
+ name => "root",
+ path => "/",
+ normalized => "/",
+ },
+ {
+ name => "current path reference",
+ path => ".",
+ normalized => ".",
+ },
+ {
+ name => "parent directory reference",
+ path => "..",
+ normalized => "..",
+ },
+ {
+ name => "single path component",
+ path => "foo",
+ normalized => "foo",
+ },
+ {
+ name => "single path component, absolute",
+ path => "/foo",
+ normalized => "/foo",
+ },
+ {
+ name => "single path component, starting with current path reference",
+ path => "./foo",
+ normalized => "./foo",
+ },
+ {
+ name => "parent directory reference, starting with current path reference",
+ path => "./..",
+ normalized => "..",
+ },
+ {
+ name => "multiple components, with redundant path separators",
+ path => "foo//bar///baz////quo/////qux//////",
+ normalized => "foo/bar/baz/quo/qux",
+ },
+ {
+ name => "multiple components, with redundant current path references",
+ path => "foo/./bar/././baz/./././quo/././././qux/././././.",
+ normalized => "foo/bar/baz/quo/qux",
+ },
+ {
+ name => "multiple components, with parent directory references",
+ path => "foo/../bar/../../baz/../../../quo/../../../../qux/../../../../..",
+ normalized => "foo/../bar/../../baz/../../../quo/../../../../qux/../../../../..",
+ },
+ {
+ name => "multiple components, with redundant path separators,"
+ . " with redundant current path references, starting with current path reference",
+ path => "././//foo/./bar///./baz/./.",
+ normalized => "./foo/bar/baz",
+ },
+ {
+ name => "multiple components, with redundant path separators,"
+ . " with redundant current path references, starting with current path reference"
+ . " (alternative)",
+ path => ".///./foo//./bar/.//baz///./",
+ normalized => "./foo/bar/baz",
+ },
+ {
+ name => "root path, with redundant path separators",
+ path => "///////////",
+ normalized => "/",
+ },
+ {
+ name => "root path, with redundant current path references",
+ path => "/./././././././././.",
+ normalized => "/",
+ },
+ {
+ name => "root with parent directory reference",
+ path => "/..",
+ normalized => "/",
+ },
+ {
+ name => "root with multiple parent directory references",
+ path => "/../../../../../../../../..",
+ normalized => "/",
+ },
+ {
+ name => "current path reference, with redundant path separators",
+ path => ".///////////",
+ normalized => ".",
+ },
+ {
+ name => "current path reference, with redundant current path references",
+ path => "./././././././././.",
+ normalized => ".",
+ },
+ {
+ name => "current path reference, with parent directory references",
+ path => "./../../..",
+ normalized => "../../..",
+ },
+ {
+ name => "multiple components,"
+ . " with redundant path separators,"
+ . " with redundant current path references,"
+ . " with parent directory references",
+ path => "foo//././//bar///./././//.//baz/.././..///quo/..////../qux/././//..",
+ normalized => "foo/bar/baz/../../quo/../../qux/..",
+ },
+ {
+ name => "multiple components, with odd component names",
+ path => ".../ \t/\t/\\/........../.~.^./.+\$={}[]()<>.../!/\"/'",
+ normalized => ".../ \t/\t/\\/........../.~.^./.+\$={}[]()<>.../!/\"/'",
+ },
+ # Diverging from File::Spec->canonpath() here -- canonpath() doesn't throw
+ # if it gets undef, but path_normalize() does in order to stay consistent
+ # with all the other functions of PVE::Path.
+ {
+ name => "path is undef",
+ path => undef,
+ normalized => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_normalize : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_normalize: " . $case->{name};
+
+ my $normalized = eval { PVE::Path::path_normalize($case->{path}); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ 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("path = " . $case->{path});
+ diag("normalized = " . $case->{normalized});
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ plan(tests => scalar($path_normalize_cases->@*));
+
+ for my $case ($path_normalize_cases->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ test_path_normalize($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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 11/12] introduce PVE::Filesystem
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (9 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 10/12] test: add tests for path_normalize " Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 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>
---
Changes v3 --> v4:
* add missing "1;" at the bottom of the module
- Thanks to Fiona for noticing!
Changes v2 --> v3:
* None
Changes v1 --> v2:
* None
src/Makefile | 1 +
src/PVE/Filesystem.pm | 79 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 80 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..d08d6e1
--- /dev/null
+++ b/src/PVE/Filesystem.pm
@@ -0,0 +1,79 @@
+=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;
+}
+
+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] 13+ messages in thread* [pve-devel] [PATCH v4 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl
2025-02-07 14:03 [pve-devel] [PATCH v4 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (10 preceding siblings ...)
2025-02-07 14:03 ` [pve-devel] [PATCH v4 pve-common 11/12] introduce PVE::Filesystem Max Carrara
@ 2025-02-07 14:03 ` Max Carrara
11 siblings, 0 replies; 13+ messages in thread
From: Max Carrara @ 2025-02-07 14:03 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>
---
Changes v3 --> v4:
* None
Changes v2 --> v3:
* None
Changes v1 --> v2:
* None
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] 13+ messages in thread