* [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-31 12:23 ` Fiona Ebner
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 02/12] test: add directory for tests of PVE::Path module Max Carrara
` (10 subsequent siblings)
11 siblings, 1 reply; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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 | 991 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 992 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..ef47d66
--- /dev/null
+++ b/src/PVE/Path.pm
@@ -0,0 +1,991 @@
+=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.
+
+=items 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.
+
+ my $joined = path_join("foo/bar", "/etc", "resolv.conf");
+ # /etc/resolv.conf
+
+ my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
+ # /etc/hosts
+
+Throws an exception if any of the passed C<@paths> is C<undef>.
+
+=cut
+
+sub path_join : prototype(@) {
+ my (@paths) = @_;
+
+ if (!scalar(@paths)) {
+ return '';
+ }
+
+ croak "one of the provided paths is undef" if any { !defined($_) } @paths;
+
+ # Find the last occurrence of a root directory and start conjoining the
+ # components from there onwards
+ my $index = scalar(@paths) - 1;
+ while ($index > 0) {
+ last if $paths[$index] =~ m#^/#;
+ $index--;
+ }
+
+ @paths = @paths[$index .. (scalar(@paths) - 1)];
+
+ my $resulting_path = shift @paths;
+
+ for my $path (@paths) {
+ $resulting_path = path_push($resulting_path, $path);
+ }
+
+ return $resulting_path;
+}
+
+=head3 path_normalize($path)
+
+Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
+C<$path>.
+
+This removes unnecessary components of a path that can be safely
+removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
+
+For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
+C<foo/bar/baz>.
+
+B<Note:> This will I<not> remove components referencing the parent directory,
+i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
+remain as they are. However, the parent directory of C</> is C</>, so
+C</../../foo> will be normalized to C</foo>.
+
+Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
+
+=cut
+
+sub path_normalize : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $cleaned_path = eval {
+ File::Spec->canonpath($path);
+ };
+
+ croak "failed to clean up path: $@" if $@;
+
+ return $cleaned_path;
+}
+
+=head3 path_parent($path)
+
+Returns the given C<$path> without its final component, if there is one.
+
+Trailing and repeated occurrences of C</> and C<.> are normalized on the fly
+when needed. This means that e.g. C<foo////bar///.//> becomes C<foo>, but
+C<foo/.//bar//./baz> becomes C<foo/.//bar>.
+
+This function's behaviour is almost identical to Rust's
+L<< Path::parent|https://doc.rust-lang.org/std/path/struct.Path.html#method.parent >>,
+with a few adaptations made wherever Perl treats things differently:
+
+=over
+
+=item * C</foo/bar> becomes C</foo>, C<foo/bar> becomes C<foo>.
+
+=item * C</foo> becomes C</>.
+
+=item * C<foo/bar/..> becomes C<foo/bar>. 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<foo> is interpreted as C<./foo> and becomes C<.>. This is because Perl's
+C<L<File::Spec/canonpath>> interprets C<./foo> and C<foo> as the same thing.
+
+=item * C</> and an I<empty string> result in C<undef> being returned.
+
+=item * C<.> results in an empty string.
+
+=back
+
+Will raise an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_parent : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if ($path eq '') {
+ return;
+ }
+
+ # A limit of -1 retains empty components at the end
+ my @components = split('/', $path, -1);
+
+ # Trim off needless extra components until actual final component is encountered, e.g.
+ # foo////bar////baz//// -> foo////bar////baz
+ # /// -> /
+ # ././//.///./ -> .
+ while (scalar(@components) > 1 && ($components[-1] eq '' || $components[-1] eq '.')) {
+ pop(@components);
+ }
+
+ my $final_component = pop(@components);
+
+ # 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 "..",
+ # and because File::Spec->canonpath treats "foo" and "./foo" the same,
+ # return a single current dir reference
+ 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.
+
+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 '';
+ return $other if path_is_absolute($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.
+
+This is essentially like calling C<L<< path_parent()|/"path_parent($path)" >>>
+and using C<L<< path_push()|/"path_push($path, $other)" >>> to append the new
+file name, but handles a few extra cases:
+
+=over
+
+=item * If C<$path> is C</>, appends C<$file_name>.
+
+=item * If C<$path> is an empty string, appends C<$file_name>.
+
+=item * If C<$path> ends with a parent directory reference (C<..>), replaces it
+with C<$file_name>.
+
+=back
+
+Throws an exception if any of the arguments is C<undef> or if C<$file_name>
+contains a path separator (C</>).
+
+=cut
+
+sub path_with_file_name : prototype($$) {
+ my ($path, $file_name) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$file_name is undef" if !defined($file_name);
+ croak "\$file_name contains a path separator: $file_name" if $file_name =~ m|/|;
+
+ my $parent = path_parent($path);
+
+ # undef means that $path was either "" or "/", so we can just append to it
+ return ($path . $file_name) if !defined($parent);
+
+ # Because the parent of "foo" is ".", return $file_name to stay consistent.
+ # Otherwise, we'd end up with a current path ref prepended ("./$file_name")
+ if ($parent eq '.' && $path !~ m|/|) {
+ return $file_name;
+ }
+
+ return path_push($parent, $file_name);
+}
+
+my sub _path_file_prefix_suffix_str : prototype($) {
+ my ($file_name) = @_;
+
+ confess "\$file_name is undef" if !defined($file_name);
+
+ confess "\$prefix not matched" if $file_name !~ m|^(\.*[^\.]*)(.*)|;
+ my ($prefix, $suffix_str) = ($1, $2);
+
+ return ($prefix, $suffix_str);
+}
+
+my sub _path_file_suffixes_from_str : prototype($) {
+ my ($suffix_str) = @_;
+
+ confess "\$suffix_str is undef" if !defined($suffix_str);
+
+ # Suffixes are extracted "manually" because join()ing the result of split()
+ # results in a different file name than the original. Let's say you have a
+ # file named "foo.bar.". The correct suffixes would be ("bar", "").
+ # With split, you get the following:
+ # split(/\./, ".bar.") --> ("", "bar") --> join()ed to "foo..bar"
+ # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar."
+ my @suffixes = ();
+ while ($suffix_str =~ s|^(\.[^\.]*)||) {
+ my $suffix = $1;
+ $suffix =~ s|^\.||;
+ push(@suffixes, $suffix);
+ }
+
+ 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
+
+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 or appended.
+
+If C<$path> does not have a file name or if C<$prefix> is an empty string,
+C<undef> is returned.
+
+ my $new_path = path_with_file_prefix("/tmp/archive.tar.zst", "backup");
+ # /tmp/backup.tar.zst
+
+ my $new_path = path_with_file_prefix("/etc/pve", "ceph");
+ # /etc/ceph
+
+Throws an exception if any of the arguments is C<undef>, or if C<$prefix>
+contains a path separator (C</>), ends with C<.>, or is an empty string.
+
+=cut
+
+sub path_with_file_prefix : prototype($$) {
+ my ($path, $prefix) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$prefix is undef" if !defined($prefix);
+ croak "\$prefix contains a path separator" if $prefix =~ m|/|;
+ croak "\$prefix ends with a dot" if $prefix =~ m|\.$|;
+
+ return undef if $prefix eq '';
+
+ 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 (undef, $suffix_str) = _path_file_prefix_suffix_str($file_name);
+
+ my $new_file_name = $prefix . $suffix_str;
+
+ # 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_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_prefix("/tmp/archive.tar.zst");
+ # ("tar", "zst")
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_suffixes : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ if (!defined($file_name)) {
+ return ();
+ }
+
+ my $suffix_str;
+ (undef, $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);
+
+ # 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_suffix($path)
+
+Returns the suffix of the C<$path>'s file name. If the C<$path> does not have a
+valid file name or if the file name has no suffix, C<undef> is returned
+instead.
+
+The suffix of a file name is essentially its extension, e.g.
+C</etc/resolv.conf> has the suffix C<conf>. If there are multiple suffixes,
+only the last will be returned; e.g. C</tmp/archive.tar.gz> has the suffix C<gz>.
+
+B<Note:> Files like e.g. C</tmp/foo.> have an empty string as suffix.
+
+For getting all suffixes of a path, see C<L<< path_file_suffixes()|/"path_file_suffixes($path)" >>>.
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_suffix : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ return undef if !defined($file_name);
+
+ my $suffix_str;
+ (undef, $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 any of the arguments is C<undef>, or if C<$suffix>
+contains a path separator (C</>) or a C<.>.
+
+=cut
+
+sub path_with_file_suffix : prototype($$) {
+ my ($path, $suffix) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ if (defined($suffix)) {
+ croak "\$suffix contains a path separator" if $suffix =~ m|/|;
+ croak "\$suffix contains a dot" if $suffix =~ m|\.|;
+ }
+
+ 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")
+ my $file_name = join(".", @file_parts);
+
+ my @file_parts = path_file_parts("/tmp/archive.tar.gz");
+ # ("archive", "tar", "gz")
+ my $file_name = join(".", @file_parts);
+
+Throws an exception if C<$path> is C<undef>.
+
+=cut
+
+sub path_file_parts : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $file_name = path_file_name($path);
+ if (!defined($file_name)) {
+ return ();
+ }
+
+ 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
+
+Throws an exception if any of the arguments is C<undef>.
+
+=cut
+
+sub path_starts_with : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing starts with nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing cannot start with something
+ # Something cannot start with nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components = path_components($path);
+ my @other_components = path_components($other_path);
+
+ my @pairs = zip_shortest(\@components, \@other_components);
+
+ # for my ($comp, $other_comp) (@pairs) is experimental
+ for my $pair (@pairs) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+=head3 path_ends_with($path, $other_path)
+
+Checks whether a C<$path> ends with the components of C<$other_path>.
+
+ my $ends_with = path_ends_with("/etc/pve/firewall/cluster.fw", "firewall/cluster.fw");
+ # 1
+
+Throws an exception if any of the arguments is C<undef>.
+
+=cut
+
+sub path_ends_with : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing ends with nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing cannot end with something
+ # Something cannot end with nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components_rev = reverse(path_components($path));
+ my @other_components_rev = reverse(path_components($other_path));
+
+ my @pairs_rev = zip_shortest(\@components_rev, \@other_components_rev);
+
+ # for my ($comp, $other_comp) (@pairs_rev) is experimental
+ for my $pair (@pairs_rev) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+=head3 path_equals($path, $other_path)
+
+Checks whether C<$path> equals C<$other_path>. The paths are compared
+by their components, meaning that it's not necessary to
+L<< normalize|/"path_normalize($path)" >> them beforehand.
+
+=cut
+
+sub path_equals : prototype($$) {
+ my ($path, $other_path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+ croak "\$other_path if undef" if !defined($other_path);
+
+ # Nothing is nothing
+ return 1 if ($path eq '' && $other_path eq '');
+
+ # Nothing is not something
+ # Something is not nothing
+ return if ($path eq '' || $other_path eq '');
+
+ my @components = path_components($path);
+ my @other_components = path_components($other_path);
+
+ return if scalar(@components) != scalar(@other_components);
+
+ my @pairs = zip_longest(\@components, \@other_components);
+
+ # for my ($comp, $other_comp) (@pairs_rev) is experimental
+ for my $pair (@pairs) {
+ my ($comp, $other_comp) = $pair->@*;
+
+ return if !defined($comp) || !defined($other_comp);
+
+ if ($comp ne $other_comp) {
+ return;
+ }
+ }
+
+ return 1;
+}
+
+1;
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* Re: [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path Max Carrara
@ 2025-01-31 12:23 ` Fiona Ebner
2025-01-31 12:33 ` Fiona Ebner
2025-02-03 14:21 ` Max Carrara
0 siblings, 2 replies; 20+ messages in thread
From: Fiona Ebner @ 2025-01-31 12:23 UTC (permalink / raw)
To: Proxmox VE development discussion, Max Carrara
Am 09.01.25 um 15:48 schrieb Max Carrara:
> +=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.
Seems like the docs are somehow broken here, looking at it with perldoc,
it just states 'Similar to "path_push()"' and the rest of the sentence
is missing.
Why this kind of behavior with absolute paths? Seems surprising to me.
Wouldn't failing the call be better?
> +
> + my $joined = path_join("foo/bar", "/etc", "resolv.conf");
> + # /etc/resolv.conf
> +
> + my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
> + # /etc/hosts
> +
> +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;
> +
I think the rest could be written more efficiently like (untested):
my $resulting_path = shift @paths;
for my $path (@paths) {
if ($path =~ m#^/#) {
$resulting_path = $path;
} else {
$resulting_path = path_push($resulting_path, $path);
}
}
> + # Find the last occurrence of a root directory and start conjoining the
> + # components from there onwards
> + my $index = scalar(@paths) - 1;
> + while ($index > 0) {
> + last if $paths[$index] =~ m#^/#;
> + $index--;
> + }
> +
> + @paths = @paths[$index .. (scalar(@paths) - 1)];
> +
> + my $resulting_path = shift @paths;
> +
> + for my $path (@paths) {
> + $resulting_path = path_push($resulting_path, $path);
> + }
> +
> + return $resulting_path;
> +}
> +
> +=head3 path_normalize($path)
> +
> +Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
> +C<$path>.
> +
> +This removes unnecessary components of a path that can be safely
> +removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
> +
> +For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
> +C<foo/bar/baz>.
> +
> +B<Note:> This will I<not> remove components referencing the parent directory,
> +i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
> +remain as they are. However, the parent directory of C</> is C</>, so
> +C</../../foo> will be normalized to C</foo>.
> +
> +Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
> +
> +=cut
> +
> +sub path_normalize : prototype($) {
> + my ($path) = @_;
> +
> + croak "\$path is undef" if !defined($path);
> +
> + my $cleaned_path = eval {
> + File::Spec->canonpath($path);
> + };
> +
Style nit: blank lines between eval and using $@ are better avoided
IMHO. I'd also have the eval expression be a single line, but no strong
feelings.
> + croak "failed to clean up path: $@" if $@;
> +
> + return $cleaned_path;
> +}
> +
> +=head3 path_parent($path)
> +
> +Returns the given C<$path> without its final component, if there is one.
> +
> +Trailing and repeated occurrences of C</> and C<.> are normalized on the fly
> +when needed. This means that e.g. C<foo////bar///.//> becomes C<foo>, but
> +C<foo/.//bar//./baz> becomes C<foo/.//bar>.
> +
> +This function's behaviour is almost identical to Rust's
> +L<< Path::parent|https://doc.rust-lang.org/std/path/struct.Path.html#method.parent >>,
> +with a few adaptations made wherever Perl treats things differently:
> +
> +=over
> +
> +=item * C</foo/bar> becomes C</foo>, C<foo/bar> becomes C<foo>.
> +
> +=item * C</foo> becomes C</>.
> +
> +=item * C<foo/bar/..> becomes C<foo/bar>. 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<foo> is interpreted as C<./foo> and becomes C<.>. This is because Perl's
> +C<L<File::Spec/canonpath>> interprets C<./foo> and C<foo> as the same thing.
I fail to see the "because" here. Why is this special handling important
in practice, i.e. why exactly care about the behavior of canonpath here?
It seems really surprising to get "." when asking for the parent of
"foo". With the normalization explained above, I'd argue it'd be much
more natural to return the empty string for both "./foo" and "foo". Or
if you want to follow Rust's parent() more closely (which I guess is the
reason for "/" and "." having different results), have "./foo" return
"." and "foo" return the empty string.
> +=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.
> +
Again, seems rather surprising to me to auto-magically do this.
> +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 '';
> + return $other if path_is_absolute($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)" >>>.
> +
Why have this alias? The name suggests it would behave like an inverse
to path_push(), but it does not, because of the normalization of
path_parent(). So I'd rather not have it or have it be a non-normalizing
version (but maybe not worth it) to avoid surprises.
> +=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 '.')
> + ) {
Style nit: this conditional fits well into 100 characters, so can be one
line instead of four
> + return;
> + }
> +
> + if ($components[-1] eq '..') {
> + return;
> + }
> +
> + return $components[-1];
> +}
> +
> +=head3 path_with_file_name($path, $file_name)
> +
> +Returns C<$path> with C<$file_name> as the new last component.
> +
> +This is essentially like calling C<L<< path_parent()|/"path_parent($path)" >>>
> +and using C<L<< path_push()|/"path_push($path, $other)" >>> to append the new
> +file name, but handles a few extra cases:
> +
> +=over
> +
> +=item * If C<$path> is C</>, appends C<$file_name>.
> +
> +=item * If C<$path> is an empty string, appends C<$file_name>.
> +
> +=item * If C<$path> ends with a parent directory reference (C<..>), replaces it
> +with C<$file_name>.
Hmm, why is that an "extra case" compared to calling path_parent() and
path_push()? I.e. your implementation doesn't handle ".." specifically.
> +
> +=back
> +
> +Throws an exception if any of the arguments is C<undef> or if C<$file_name>
> +contains a path separator (C</>).
> +
> +=cut
> +
> +sub path_with_file_name : prototype($$) {
> + my ($path, $file_name) = @_;
> +
> + croak "\$path is undef" if !defined($path);
> + croak "\$file_name is undef" if !defined($file_name);
> + croak "\$file_name contains a path separator: $file_name" if $file_name =~ m|/|;
> +
> + my $parent = path_parent($path);
> +
> + # undef means that $path was either "" or "/", so we can just append to it
> + return ($path . $file_name) if !defined($parent);
> +
> + # Because the parent of "foo" is ".", return $file_name to stay consistent.
> + # Otherwise, we'd end up with a current path ref prepended ("./$file_name")
> + if ($parent eq '.' && $path !~ m|/|) {
> + return $file_name;
> + }
See, you already need special handling because of that surprising
behavior ;)
> +
> + return path_push($parent, $file_name);
> +}
> +
> +my sub _path_file_prefix_suffix_str : prototype($) {
> + my ($file_name) = @_;
> +
> + confess "\$file_name is undef" if !defined($file_name);
> +
> + confess "\$prefix not matched" if $file_name !~ m|^(\.*[^\.]*)(.*)|;
> + my ($prefix, $suffix_str) = ($1, $2);
> +
> + return ($prefix, $suffix_str);
> +}
> +
> +my sub _path_file_suffixes_from_str : prototype($) {
> + my ($suffix_str) = @_;
> +
> + confess "\$suffix_str is undef" if !defined($suffix_str);
> +
> + # Suffixes are extracted "manually" because join()ing the result of split()
> + # results in a different file name than the original. Let's say you have a
> + # file named "foo.bar.". The correct suffixes would be ("bar", "").
> + # With split, you get the following:
> + # split(/\./, ".bar.") --> ("", "bar") --> join()ed to "foo..bar"
> + # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar."
Couldn't you just shift away the first entry from the result?
> + my @suffixes = ();
> + while ($suffix_str =~ s|^(\.[^\.]*)||) {
> + my $suffix = $1;
> + $suffix =~ s|^\.||;
Nit: Could also use substr() rather then regex replace.
> + push(@suffixes, $suffix);
> + }
> +
> + 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
> +
> +Throws an exception if C<$path> is C<undef>.
> +
Documentation should mention how dot files (e.g. .foo.txt) are treated.
> +=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)
> +
Hmm, looking at this and path_with_file_suffix{,es}(), would it maybe be
nicer to have a single
path_with_file_name_from_parts($path, $prefix, @suffixes)
function instead of these? Would seem more natural/straightforward to
me. The implementations are rather involved IMHO compared to how useful
the functions are. It's very easy to get the behavior for the (I suspect
rather uncommon) case of where you want to replace only prefix or
suffix(es) without already knowing the other. Just need to call
path_file_parts() first. Or did you take inspiration from somewhere else
for these?
---snip 8<---
> +=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")
> + my $file_name = join(".", @file_parts);
> +
> + my @file_parts = path_file_parts("/tmp/archive.tar.gz");
> + # ("archive", "tar", "gz")
> + my $file_name = join(".", @file_parts);
> +
> +Throws an exception if C<$path> is C<undef>.
> +
Should mention how dot files are treated.
> +=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
> +
> +Throws an exception if any of the arguments is C<undef>.
> +
Should document the behavior for empty paths as well as the normalization.
> +=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);
Why not just shift off from both in a loop?
> +
> + # for my ($comp, $other_comp) (@pairs) is experimental
> + for my $pair (@pairs) {
> + my ($comp, $other_comp) = $pair->@*;
> +
> + if ($comp ne $other_comp) {
> + return;
> + }
> + }
> +
> + return 1;
> +}
> +
> +=head3 path_ends_with($path, $other_path)
> +
> +Checks whether a C<$path> ends with the components of C<$other_path>.
> +
> + my $ends_with = path_ends_with("/etc/pve/firewall/cluster.fw", "firewall/cluster.fw");
> + # 1
> +
> +Throws an exception if any of the arguments is C<undef>.
> +
Should document the behavior for empty paths as well as the normalization.
> +=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);
Why not just shift off from both in a loop?
> +
> + # for my ($comp, $other_comp) (@pairs_rev) is experimental
> + for my $pair (@pairs_rev) {
> + my ($comp, $other_comp) = $pair->@*;
> +
> + if ($comp ne $other_comp) {
> + return;
> + }
> + }
> +
> + return 1;
> +}
> +
> +=head3 path_equals($path, $other_path)
> +
> +Checks whether C<$path> equals C<$other_path>. The paths are compared
> +by their components, meaning that it's not necessary to
> +L<< normalize|/"path_normalize($path)" >> them beforehand.
> +
> +=cut
> +
> +sub path_equals : prototype($$) {
> + my ($path, $other_path) = @_;
> +
> + croak "\$path is undef" if !defined($path);
> + croak "\$other_path if undef" if !defined($other_path);
> +
> + # Nothing is nothing
> + return 1 if ($path eq '' && $other_path eq '');
> +
> + # Nothing is not something
> + # Something is not nothing
> + return if ($path eq '' || $other_path eq '');
> +
> + my @components = path_components($path);
> + my @other_components = path_components($other_path);
> +
> + return if scalar(@components) != scalar(@other_components);
> +
> + my @pairs = zip_longest(\@components, \@other_components);
Why not just shift off from both in a loop?
> +
> + # 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;
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* Re: [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-01-31 12:23 ` Fiona Ebner
@ 2025-01-31 12:33 ` Fiona Ebner
2025-02-03 14:21 ` Max Carrara
1 sibling, 0 replies; 20+ messages in thread
From: Fiona Ebner @ 2025-01-31 12:33 UTC (permalink / raw)
To: Proxmox VE development discussion, Max Carrara
Am 31.01.25 um 13:23 schrieb Fiona Ebner:
> Am 09.01.25 um 15:48 schrieb Max Carrara:
>> +=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.
>
> Seems like the docs are somehow broken here, looking at it with perldoc,
> it just states 'Similar to "path_push()"' and the rest of the sentence
> is missing.
>
perldoc src/PVE/Path.pm will tell you at the end:
POD ERRORS
Hey! The above document had some coding errors, which are explained
below:
Around line 160:
Unknown directive: =items
Around line 209:
Unterminated C<L< ... >> sequence
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* Re: [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-01-31 12:23 ` Fiona Ebner
2025-01-31 12:33 ` Fiona Ebner
@ 2025-02-03 14:21 ` Max Carrara
2025-02-03 15:42 ` Fiona Ebner
1 sibling, 1 reply; 20+ messages in thread
From: Max Carrara @ 2025-02-03 14:21 UTC (permalink / raw)
To: Fiona Ebner, Proxmox VE development discussion
On Fri Jan 31, 2025 at 1:23 PM CET, Fiona Ebner wrote:
> Am 09.01.25 um 15:48 schrieb Max Carrara:
> > +=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.
>
> Seems like the docs are somehow broken here, looking at it with perldoc,
> it just states 'Similar to "path_push()"' and the rest of the sentence
> is missing.
My bad; made a typo in the docstring for path_components() (just above
this function). Thanks for spotting this!
>
> Why this kind of behavior with absolute paths? Seems surprising to me.
> Wouldn't failing the call be better?
I decided to stick with Rust's behaviour [pathbuf] here and in most
other places, simply in order to keep the behaviour consistent.
I'm not *really* a fan of it either, but I think it's better than
failing the call -- IMO having to wrap path_join / path_push into an
eval-block would be quite awkward for what's a rather "small" operation
:s
Perhaps I should provide some additional context here as well so as to
make my "design philosophy" more clear: The reason why I modeled
PVE::Path (mostly) after Rust's std::path::{Path, PathBuf} is because:
1. Most (newer) developers will be much more likely to be familiar
with Rust instead of Perl, so if they should see this library,
they'll have a much easier time using it (or at least that's what
I *hope* would happen). Sort of as in: "Oh, this is just like the
path stuff in Rust, except for a few Perl-esque exceptions!"
2. I wanted the library to be essentially exception-free, except where
obvious invariants aren't upheld by the caller (e.g. passing undef).
Unless you match the error message with a regex, there's no
structurally typed way to differ between errors in Perl, so I'd
like the "types" of errors to be mostly the same wherever possible.
3. I didn't want to reinvent the wheel and instead stick to what other
popular libraries do as much as possible, while also avoiding any
additional abstractions (e.g. introducing an object for paths).
With all that being said, since that behaviour is surprising to you, I
have no quarrels changing it! :P After all I'd like to have something
that doesn't cause any friction when using it.
[pathbuf]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.push
>
> > +
> > + my $joined = path_join("foo/bar", "/etc", "resolv.conf");
> > + # /etc/resolv.conf
> > +
> > + my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
> > + # /etc/hosts
> > +
> > +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;
> > +
>
> I think the rest could be written more efficiently like (untested):
>
> my $resulting_path = shift @paths;
> for my $path (@paths) {
> if ($path =~ m#^/#) {
> $resulting_path = $path;
> } else {
> $resulting_path = path_push($resulting_path, $path);
> }
> }
Note that I'm doing a reverse iteration below; I think doing it either
way should be fine, because I doubt we'll ever need to join that many
path components where it's actually going to make a difference ;P
>
> > + # Find the last occurrence of a root directory and start conjoining the
> > + # components from there onwards
> > + my $index = scalar(@paths) - 1;
> > + while ($index > 0) {
> > + last if $paths[$index] =~ m#^/#;
> > + $index--;
> > + }
> > +
> > + @paths = @paths[$index .. (scalar(@paths) - 1)];
> > +
> > + my $resulting_path = shift @paths;
> > +
> > + for my $path (@paths) {
> > + $resulting_path = path_push($resulting_path, $path);
> > + }
> > +
> > + return $resulting_path;
> > +}
> > +
> > +=head3 path_normalize($path)
> > +
> > +Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
> > +C<$path>.
> > +
> > +This removes unnecessary components of a path that can be safely
> > +removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
> > +
> > +For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
> > +C<foo/bar/baz>.
> > +
> > +B<Note:> This will I<not> remove components referencing the parent directory,
> > +i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
> > +remain as they are. However, the parent directory of C</> is C</>, so
> > +C</../../foo> will be normalized to C</foo>.
> > +
> > +Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
> > +
> > +=cut
> > +
> > +sub path_normalize : prototype($) {
> > + my ($path) = @_;
> > +
> > + croak "\$path is undef" if !defined($path);
> > +
> > + my $cleaned_path = eval {
> > + File::Spec->canonpath($path);
> > + };
> > +
>
> Style nit: blank lines between eval and using $@ are better avoided
> IMHO. I'd also have the eval expression be a single line, but no strong
> feelings.
Could you perhaps elaborate why, please?
>
> > + croak "failed to clean up path: $@" if $@;
> > +
> > + return $cleaned_path;
> > +}
> > +
> > +=head3 path_parent($path)
> > +
> > +Returns the given C<$path> without its final component, if there is one.
> > +
> > +Trailing and repeated occurrences of C</> and C<.> are normalized on the fly
> > +when needed. This means that e.g. C<foo////bar///.//> becomes C<foo>, but
> > +C<foo/.//bar//./baz> becomes C<foo/.//bar>.
> > +
> > +This function's behaviour is almost identical to Rust's
> > +L<< Path::parent|https://doc.rust-lang.org/std/path/struct.Path.html#method.parent >>,
> > +with a few adaptations made wherever Perl treats things differently:
> > +
> > +=over
> > +
> > +=item * C</foo/bar> becomes C</foo>, C<foo/bar> becomes C<foo>.
> > +
> > +=item * C</foo> becomes C</>.
> > +
> > +=item * C<foo/bar/..> becomes C<foo/bar>. 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<foo> is interpreted as C<./foo> and becomes C<.>. This is because Perl's
> > +C<L<File::Spec/canonpath>> interprets C<./foo> and C<foo> as the same thing.
>
> I fail to see the "because" here. Why is this special handling important
> in practice, i.e. why exactly care about the behavior of canonpath here?
> It seems really surprising to get "." when asking for the parent of
> "foo". With the normalization explained above, I'd argue it'd be much
> more natural to return the empty string for both "./foo" and "foo". Or
> if you want to follow Rust's parent() more closely (which I guess is the
> reason for "/" and "." having different results), have "./foo" return
> "." and "foo" return the empty string.
Yeah, this is the only thing where I wasn't sure if it's the right way
to go. The reason why I chose to handle it that way is because
File::Spec->canonpath() will return "foo" for both "foo" and "./foo"
-- and I wasn't 100% sure whether *not* handling it the same will be
detrimental elsewhere.
I totally get that it's unexpected though, so I really wouldn't mind
changing it to one of the two alternatives you suggested. :P
(Addendum: Handling paths is really finicky, so in cases where I wasn't
100% convinced of something I decided to be conservative instead; this
is one such case. 😅)
>
> > +=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.
> > +
>
> Again, seems rather surprising to me to auto-magically do this.
See my elaboration further above.
>
> > +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 '';
> > + return $other if path_is_absolute($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)" >>>.
> > +
>
> Why have this alias? The name suggests it would behave like an inverse
> to path_push(), but it does not, because of the normalization of
> path_parent(). So I'd rather not have it or have it be a non-normalizing
> version (but maybe not worth it) to avoid surprises.
Could you please elaborate what you mean regarding the normalization of
path_parent()?
path_parent() (or path_pop()) will only normalize as much as it needs to
in order to remove the last path component and get to the one that
precedes that:
my $p = "foo/././bar/././baz/./.";
$p = PVE::Path::path_parent($p): # or path_pop()
# $p is now "foo/././bar"
path_push() does actually behave like an inverse if you include the
redundant stuff:
$p = PVE::Path::path_push($p, "././baz/./.")
# $p is now "foo/././bar/././baz/./." again
It's not a complete inverse, that's true (as in, it's not bijective ;P),
because you can't replicate the example above with a path like
"foo///bar///baz" since you can't push "///baz" onto "foo///bar"
("///baz" is treated as an absolute path).
I think a non-normalizing version wouldn't really be that nice to use;
one would have to constantly remember to call path_normalize()
beforehand to actually get the desired result (i.e. getting the parent
directory).
I can just remove the alias if you prefer; it's not equivalent to Rust's
PathBuf::pop() [pop] and if it's a source of confusion, we can probably
do without.
[pop]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.pop
>
> > +=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 '.')
> > + ) {
>
> Style nit: this conditional fits well into 100 characters, so can be one
> line instead of four
Fair point, but I prefer to have it a little more readable here, and
it's still in line with our style guide. :P
>
> > + return;
> > + }
> > +
> > + if ($components[-1] eq '..') {
> > + return;
> > + }
> > +
> > + return $components[-1];
> > +}
> > +
> > +=head3 path_with_file_name($path, $file_name)
> > +
> > +Returns C<$path> with C<$file_name> as the new last component.
> > +
> > +This is essentially like calling C<L<< path_parent()|/"path_parent($path)" >>>
> > +and using C<L<< path_push()|/"path_push($path, $other)" >>> to append the new
> > +file name, but handles a few extra cases:
> > +
> > +=over
> > +
> > +=item * If C<$path> is C</>, appends C<$file_name>.
> > +
> > +=item * If C<$path> is an empty string, appends C<$file_name>.
> > +
> > +=item * If C<$path> ends with a parent directory reference (C<..>), replaces it
> > +with C<$file_name>.
>
> Hmm, why is that an "extra case" compared to calling path_parent() and
> path_push()? I.e. your implementation doesn't handle ".." specifically.
>
This is stated here for completeness's sake, but I guess it's not really
an extra case, yeah.
However, you made me check the exact details again though, and it seems
that Rust's PathBuf::set_file_name() [sfn] would actually behave
differently here; if a path ends with a parent dir reference, it would
actually just append the file name, not replace it :P
.. so, thanks for spotting this! I actually want to adapt this now 😄
[sfn]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.set_file_name
> > +
> > +=back
> > +
> > +Throws an exception if any of the arguments is C<undef> or if C<$file_name>
> > +contains a path separator (C</>).
> > +
> > +=cut
> > +
> > +sub path_with_file_name : prototype($$) {
> > + my ($path, $file_name) = @_;
> > +
> > + croak "\$path is undef" if !defined($path);
> > + croak "\$file_name is undef" if !defined($file_name);
> > + croak "\$file_name contains a path separator: $file_name" if $file_name =~ m|/|;
> > +
> > + my $parent = path_parent($path);
> > +
> > + # undef means that $path was either "" or "/", so we can just append to it
> > + return ($path . $file_name) if !defined($parent);
> > +
> > + # Because the parent of "foo" is ".", return $file_name to stay consistent.
> > + # Otherwise, we'd end up with a current path ref prepended ("./$file_name")
> > + if ($parent eq '.' && $path !~ m|/|) {
> > + return $file_name;
> > + }
>
> See, you already need special handling because of that surprising
> behavior ;)
Well yeah, because I chose the behaviour of path_parent() to be the way
it is; of course I'm gonna ensure the other functions take that decision
into account too 😅
>
> > +
> > + return path_push($parent, $file_name);
> > +}
> > +
> > +my sub _path_file_prefix_suffix_str : prototype($) {
> > + my ($file_name) = @_;
> > +
> > + confess "\$file_name is undef" if !defined($file_name);
> > +
> > + confess "\$prefix not matched" if $file_name !~ m|^(\.*[^\.]*)(.*)|;
> > + my ($prefix, $suffix_str) = ($1, $2);
> > +
> > + return ($prefix, $suffix_str);
> > +}
> > +
> > +my sub _path_file_suffixes_from_str : prototype($) {
> > + my ($suffix_str) = @_;
> > +
> > + confess "\$suffix_str is undef" if !defined($suffix_str);
> > +
> > + # Suffixes are extracted "manually" because join()ing the result of split()
> > + # results in a different file name than the original. Let's say you have a
> > + # file named "foo.bar.". The correct suffixes would be ("bar", "").
> > + # With split, you get the following:
> > + # split(/\./, ".bar.") --> ("", "bar") --> join()ed to "foo..bar"
> > + # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar."
>
> Couldn't you just shift away the first entry from the result?
Hm, I think so. I'll see how it behaves. Thanks for the suggestion!
>
> > + my @suffixes = ();
> > + while ($suffix_str =~ s|^(\.[^\.]*)||) {
> > + my $suffix = $1;
> > + $suffix =~ s|^\.||;
>
> Nit: Could also use substr() rather then regex replace.
Good catch, thanks!
>
> > + push(@suffixes, $suffix);
> > + }
> > +
> > + 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
> > +
> > +Throws an exception if C<$path> is C<undef>.
> > +
>
> Documentation should mention how dot files (e.g. .foo.txt) are treated.
>
Sure, I can add that.
FWIW in the case of ".foo.txt", the prefix would be ".foo".
> > +=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)
> > +
>
> Hmm, looking at this and path_with_file_suffix{,es}(), would it maybe be
> nicer to have a single
> path_with_file_name_from_parts($path, $prefix, @suffixes)
> function instead of these? Would seem more natural/straightforward to
> me. The implementations are rather involved IMHO compared to how useful
> the functions are. It's very easy to get the behavior for the (I suspect
> rather uncommon) case of where you want to replace only prefix or
> suffix(es) without already knowing the other. Just need to call
> path_file_parts() first. Or did you take inspiration from somewhere else
> for these?
I'll have to disagree here precisely because having to call
path_file_parts() first is IMO tedious from the caller's perspective. In
many cases I rarely care about all of the individual parts; instead I
just e.g. want to rename a file while keeping the suffix(es), or I want to
trim off the last suffix of something like "archive.tar.gz" because I'm
decompressing it to "archive.tar" or similar.
In other words, in a lot of cases I just want to perform one individual
operation, and the path_file_* and path_with_file_* functions represent
all those individual operations as concisely as possible. The burden of
"figuring out what to do" shouldn't be given to the caller in such
cases.
Regarding inspiration: These functions were inspired after having read a
related Rust GitHub issue [issue] where a lot of this was discussed as
well.
That issue also suggests having some kind of iterator for file parts,
that other methods of std::path::Path can be based on; this is actually
what led me to adding path_file_parts() below. You have access to the
individual parts there and can just join() them to the file name. That
would be very similar to the path_with_file_name_from_parts() function
you suggested. :P
[issue]: https://github.com/rust-lang/rust/issues/86319
>
> ---snip 8<---
>
> > +=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")
> > + my $file_name = join(".", @file_parts);
> > +
> > + my @file_parts = path_file_parts("/tmp/archive.tar.gz");
> > + # ("archive", "tar", "gz")
> > + my $file_name = join(".", @file_parts);
> > +
> > +Throws an exception if C<$path> is C<undef>.
> > +
>
> Should mention how dot files are treated.
Sure thing!
>
> > +=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
> > +
> > +Throws an exception if any of the arguments is C<undef>.
> > +
>
> Should document the behavior for empty paths as well as the normalization.
ACK, will add that!
>
> > +=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);
>
> Why not just shift off from both in a loop?
>
Sure, that's of course also possible; I just found zip_shortest more
expressive.
> > +
> > + # for my ($comp, $other_comp) (@pairs) is experimental
> > + for my $pair (@pairs) {
> > + my ($comp, $other_comp) = $pair->@*;
> > +
> > + if ($comp ne $other_comp) {
> > + return;
> > + }
> > + }
> > +
> > + return 1;
> > +}
> > +
> > +=head3 path_ends_with($path, $other_path)
> > +
> > +Checks whether a C<$path> ends with the components of C<$other_path>.
> > +
> > + my $ends_with = path_ends_with("/etc/pve/firewall/cluster.fw", "firewall/cluster.fw");
> > + # 1
> > +
> > +Throws an exception if any of the arguments is C<undef>.
> > +
>
> Should document the behavior for empty paths as well as the normalization.
>
Same as above; will do that.
> > +=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);
>
> Why not just shift off from both in a loop?
>
Same as above; just found zip_shortest more expressive.
> > +
> > + # for my ($comp, $other_comp) (@pairs_rev) is experimental
> > + for my $pair (@pairs_rev) {
> > + my ($comp, $other_comp) = $pair->@*;
> > +
> > + if ($comp ne $other_comp) {
> > + return;
> > + }
> > + }
> > +
> > + return 1;
> > +}
> > +
> > +=head3 path_equals($path, $other_path)
> > +
> > +Checks whether C<$path> equals C<$other_path>. The paths are compared
> > +by their components, meaning that it's not necessary to
> > +L<< normalize|/"path_normalize($path)" >> them beforehand.
> > +
> > +=cut
> > +
> > +sub path_equals : prototype($$) {
> > + my ($path, $other_path) = @_;
> > +
> > + croak "\$path is undef" if !defined($path);
> > + croak "\$other_path if undef" if !defined($other_path);
> > +
> > + # Nothing is nothing
> > + return 1 if ($path eq '' && $other_path eq '');
> > +
> > + # Nothing is not something
> > + # Something is not nothing
> > + return if ($path eq '' || $other_path eq '');
> > +
> > + my @components = path_components($path);
> > + my @other_components = path_components($other_path);
> > +
> > + return if scalar(@components) != scalar(@other_components);
> > +
> > + my @pairs = zip_longest(\@components, \@other_components);
>
> Why not just shift off from both in a loop?
>
Similar to above, I just found zip_longest more expressive.
> > +
> > + # 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;
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* Re: [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-02-03 14:21 ` Max Carrara
@ 2025-02-03 15:42 ` Fiona Ebner
2025-02-03 16:45 ` Max Carrara
0 siblings, 1 reply; 20+ messages in thread
From: Fiona Ebner @ 2025-02-03 15:42 UTC (permalink / raw)
To: Max Carrara, Proxmox VE development discussion
Am 03.02.25 um 15:21 schrieb Max Carrara:
> On Fri Jan 31, 2025 at 1:23 PM CET, Fiona Ebner wrote:
>> Am 09.01.25 um 15:48 schrieb Max Carrara:
>>
>> Why this kind of behavior with absolute paths? Seems surprising to me.
>> Wouldn't failing the call be better?
>
> I decided to stick with Rust's behaviour [pathbuf] here and in most
> other places, simply in order to keep the behaviour consistent.
>
> I'm not *really* a fan of it either, but I think it's better than
> failing the call -- IMO having to wrap path_join / path_push into an
> eval-block would be quite awkward for what's a rather "small" operation
> :s
>
> Perhaps I should provide some additional context here as well so as to
> make my "design philosophy" more clear: The reason why I modeled
> PVE::Path (mostly) after Rust's std::path::{Path, PathBuf} is because:
>
> 1. Most (newer) developers will be much more likely to be familiar
> with Rust instead of Perl, so if they should see this library,
> they'll have a much easier time using it (or at least that's what
> I *hope* would happen). Sort of as in: "Oh, this is just like the
> path stuff in Rust, except for a few Perl-esque exceptions!"
>
> 2. I wanted the library to be essentially exception-free, except where
> obvious invariants aren't upheld by the caller (e.g. passing undef).
> Unless you match the error message with a regex, there's no
> structurally typed way to differ between errors in Perl, so I'd
> like the "types" of errors to be mostly the same wherever possible.
>
> 3. I didn't want to reinvent the wheel and instead stick to what other
> popular libraries do as much as possible, while also avoiding any
> additional abstractions (e.g. introducing an object for paths).
>
> With all that being said, since that behaviour is surprising to you, I
> have no quarrels changing it! :P After all I'd like to have something
> that doesn't cause any friction when using it.
>
> [pathbuf]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.push
>
You don't need to change it if there was good rationale behind it, which
you provided :) A short comment in the function documentation regarding
the inspiration would still be nice. Puts the responsibility on the
caller to not accidentally use an absolute path though. Maybe we can at
least warn instead? I suspect almost all calls with an absolute path in
the middle will be accidental.
>>
>>> +
>>> + my $joined = path_join("foo/bar", "/etc", "resolv.conf");
>>> + # /etc/resolv.conf
>>> +
>>> + my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
>>> + # /etc/hosts
>>> +
>>> +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;
>>> +
>>
>> I think the rest could be written more efficiently like (untested):
>>
>> my $resulting_path = shift @paths;
>> for my $path (@paths) {
>> if ($path =~ m#^/#) {
>> $resulting_path = $path;
>> } else {
>> $resulting_path = path_push($resulting_path, $path);
>> }
>> }
>
> Note that I'm doing a reverse iteration below; I think doing it either
> way should be fine, because I doubt we'll ever need to join that many
> path components where it's actually going to make a difference ;P
>
I also meant "efficiently" in terms of lines/readability ;) Shorter,
less loops and avoids index arithmetic.
>>
>>> + # Find the last occurrence of a root directory and start conjoining the
>>> + # components from there onwards
>>> + my $index = scalar(@paths) - 1;
>>> + while ($index > 0) {
>>> + last if $paths[$index] =~ m#^/#;
>>> + $index--;
>>> + }
>>> +
>>> + @paths = @paths[$index .. (scalar(@paths) - 1)];
>>> +
>>> + my $resulting_path = shift @paths;
>>> +
>>> + for my $path (@paths) {
>>> + $resulting_path = path_push($resulting_path, $path);
>>> + }
>>> +
>>> + return $resulting_path;
>>> +}
>>> +
>>> +=head3 path_normalize($path)
>>> +
>>> +Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
>>> +C<$path>.
>>> +
>>> +This removes unnecessary components of a path that can be safely
>>> +removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
>>> +
>>> +For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
>>> +C<foo/bar/baz>.
>>> +
>>> +B<Note:> This will I<not> remove components referencing the parent directory,
>>> +i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
>>> +remain as they are. However, the parent directory of C</> is C</>, so
>>> +C</../../foo> will be normalized to C</foo>.
>>> +
>>> +Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
>>> +
>>> +=cut
>>> +
>>> +sub path_normalize : prototype($) {
>>> + my ($path) = @_;
>>> +
>>> + croak "\$path is undef" if !defined($path);
>>> +
>>> + my $cleaned_path = eval {
>>> + File::Spec->canonpath($path);
>>> + };
>>> +
>>
>> Style nit: blank lines between eval and using $@ are better avoided
>> IMHO. I'd also have the eval expression be a single line, but no strong
>> feelings.
>
> Could you perhaps elaborate why, please?
>
Because new code gets added more easily in between. I've seen that
happen before.
---snip 8<---
>>> +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 '';
>>> + return $other if path_is_absolute($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)" >>>.
>>> +
>>
>> Why have this alias? The name suggests it would behave like an inverse
>> to path_push(), but it does not, because of the normalization of
>> path_parent(). So I'd rather not have it or have it be a non-normalizing
>> version (but maybe not worth it) to avoid surprises.
>
> Could you please elaborate what you mean regarding the normalization of
> path_parent()?
I just mean push "." followed by pop is not the same as you start with.
>
> path_parent() (or path_pop()) will only normalize as much as it needs to
> in order to remove the last path component and get to the one that
> precedes that:
>
> my $p = "foo/././bar/././baz/./.";
>
> $p = PVE::Path::path_parent($p): # or path_pop()
> # $p is now "foo/././bar"
>
> path_push() does actually behave like an inverse if you include the
> redundant stuff:
>
> $p = PVE::Path::path_push($p, "././baz/./.")
> # $p is now "foo/././bar/././baz/./." again
>
> It's not a complete inverse, that's true (as in, it's not bijective ;P),
> because you can't replicate the example above with a path like
> "foo///bar///baz" since you can't push "///baz" onto "foo///bar"
> ("///baz" is treated as an absolute path).
>
> I think a non-normalizing version wouldn't really be that nice to use;
> one would have to constantly remember to call path_normalize()
> beforehand to actually get the desired result (i.e. getting the parent
> directory).
Agreed.
>
> I can just remove the alias if you prefer; it's not equivalent to Rust's
> PathBuf::pop() [pop] and if it's a source of confusion, we can probably
> do without.
>
> [pop]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.pop
>
I see where the inspiration comes from then :) I get why Rust has both,
because one is for Path and the other for PathBuf. And since they are
essentially the same operation, fine by me to keep this alias.
>>
>>> +=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 '.')
>>> + ) {
>>
>> Style nit: this conditional fits well into 100 characters, so can be one
>> line instead of four
>
> Fair point, but I prefer to have it a little more readable here, and
> it's still in line with our style guide. :P
Personally, I find this version "more noisy" to read, because of the
split, but no hard feelings :)
---snip 8<---
>>> +=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)
>>> +
>>
>> Hmm, looking at this and path_with_file_suffix{,es}(), would it maybe be
>> nicer to have a single
>> path_with_file_name_from_parts($path, $prefix, @suffixes)
>> function instead of these? Would seem more natural/straightforward to
>> me. The implementations are rather involved IMHO compared to how useful
>> the functions are. It's very easy to get the behavior for the (I suspect
>> rather uncommon) case of where you want to replace only prefix or
>> suffix(es) without already knowing the other. Just need to call
>> path_file_parts() first. Or did you take inspiration from somewhere else
>> for these?
>
> I'll have to disagree here precisely because having to call
> path_file_parts() first is IMO tedious from the caller's perspective. In
> many cases I rarely care about all of the individual parts; instead I
> just e.g. want to rename a file while keeping the suffix(es), or I want to
> trim off the last suffix of something like "archive.tar.gz" because I'm
> decompressing it to "archive.tar" or similar.
>
> In other words, in a lot of cases I just want to perform one individual
> operation, and the path_file_* and path_with_file_* functions represent
> all those individual operations as concisely as possible. The burden of
> "figuring out what to do" shouldn't be given to the caller in such
> cases.
>
> Regarding inspiration: These functions were inspired after having read a
> related Rust GitHub issue [issue] where a lot of this was discussed as
> well.
>
> That issue also suggests having some kind of iterator for file parts,
> that other methods of std::path::Path can be based on; this is actually
> what led me to adding path_file_parts() below. You have access to the
> individual parts there and can just join() them to the file name. That
> would be very similar to the path_with_file_name_from_parts() function
> you suggested. :P
>
> [issue]: https://github.com/rust-lang/rust/issues/86319
>
Okay, thank you for elaborating! Maybe such calls are more common than I
think.
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* Re: [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path
2025-02-03 15:42 ` Fiona Ebner
@ 2025-02-03 16:45 ` Max Carrara
0 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-02-03 16:45 UTC (permalink / raw)
To: Fiona Ebner, Proxmox VE development discussion
On Mon Feb 3, 2025 at 4:42 PM CET, Fiona Ebner wrote:
> Am 03.02.25 um 15:21 schrieb Max Carrara:
> > On Fri Jan 31, 2025 at 1:23 PM CET, Fiona Ebner wrote:
> >> Am 09.01.25 um 15:48 schrieb Max Carrara:
> >>
> >> Why this kind of behavior with absolute paths? Seems surprising to me.
> >> Wouldn't failing the call be better?
> >
> > I decided to stick with Rust's behaviour [pathbuf] here and in most
> > other places, simply in order to keep the behaviour consistent.
> >
> > I'm not *really* a fan of it either, but I think it's better than
> > failing the call -- IMO having to wrap path_join / path_push into an
> > eval-block would be quite awkward for what's a rather "small" operation
> > :s
> >
> > Perhaps I should provide some additional context here as well so as to
> > make my "design philosophy" more clear: The reason why I modeled
> > PVE::Path (mostly) after Rust's std::path::{Path, PathBuf} is because:
> >
> > 1. Most (newer) developers will be much more likely to be familiar
> > with Rust instead of Perl, so if they should see this library,
> > they'll have a much easier time using it (or at least that's what
> > I *hope* would happen). Sort of as in: "Oh, this is just like the
> > path stuff in Rust, except for a few Perl-esque exceptions!"
> >
> > 2. I wanted the library to be essentially exception-free, except where
> > obvious invariants aren't upheld by the caller (e.g. passing undef).
> > Unless you match the error message with a regex, there's no
> > structurally typed way to differ between errors in Perl, so I'd
> > like the "types" of errors to be mostly the same wherever possible.
> >
> > 3. I didn't want to reinvent the wheel and instead stick to what other
> > popular libraries do as much as possible, while also avoiding any
> > additional abstractions (e.g. introducing an object for paths).
> >
> > With all that being said, since that behaviour is surprising to you, I
> > have no quarrels changing it! :P After all I'd like to have something
> > that doesn't cause any friction when using it.
> >
> > [pathbuf]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.push
> >
>
> You don't need to change it if there was good rationale behind it, which
> you provided :) A short comment in the function documentation regarding
> the inspiration would still be nice. Puts the responsibility on the
> caller to not accidentally use an absolute path though. Maybe we can at
> least warn instead? I suspect almost all calls with an absolute path in
> the middle will be accidental.
Sure, that sounds fine by me! :)
>
> >>
> >>> +
> >>> + my $joined = path_join("foo/bar", "/etc", "resolv.conf");
> >>> + # /etc/resolv.conf
> >>> +
> >>> + my $joined = path_join("foo", "/etc/resolv.conf", "/etc/hosts");
> >>> + # /etc/hosts
> >>> +
> >>> +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;
> >>> +
> >>
> >> I think the rest could be written more efficiently like (untested):
> >>
> >> my $resulting_path = shift @paths;
> >> for my $path (@paths) {
> >> if ($path =~ m#^/#) {
> >> $resulting_path = $path;
> >> } else {
> >> $resulting_path = path_push($resulting_path, $path);
> >> }
> >> }
> >
> > Note that I'm doing a reverse iteration below; I think doing it either
> > way should be fine, because I doubt we'll ever need to join that many
> > path components where it's actually going to make a difference ;P
> >
>
> I also meant "efficiently" in terms of lines/readability ;) Shorter,
> less loops and avoids index arithmetic.
Oooh, that makes sense then! Sure, I'll give it a try :)
>
> >>
> >>> + # Find the last occurrence of a root directory and start conjoining the
> >>> + # components from there onwards
> >>> + my $index = scalar(@paths) - 1;
> >>> + while ($index > 0) {
> >>> + last if $paths[$index] =~ m#^/#;
> >>> + $index--;
> >>> + }
> >>> +
> >>> + @paths = @paths[$index .. (scalar(@paths) - 1)];
> >>> +
> >>> + my $resulting_path = shift @paths;
> >>> +
> >>> + for my $path (@paths) {
> >>> + $resulting_path = path_push($resulting_path, $path);
> >>> + }
> >>> +
> >>> + return $resulting_path;
> >>> +}
> >>> +
> >>> +=head3 path_normalize($path)
> >>> +
> >>> +Wrapper for L<C<File::Spec/canonpath>>. Performs a logical cleanup of the given
> >>> +C<$path>.
> >>> +
> >>> +This removes unnecessary components of a path that can be safely
> >>> +removed, such as C<.>, trailing C</> or repeated occurrences of C</>.
> >>> +
> >>> +For example, C<foo/./bar/baz/.> and C<foo////bar//baz//> will both become
> >>> +C<foo/bar/baz>.
> >>> +
> >>> +B<Note:> This will I<not> remove components referencing the parent directory,
> >>> +i.e. C<..>. For example, C<foo/bar/../baz> and C<foo/bar/baz/..> will therefore
> >>> +remain as they are. However, the parent directory of C</> is C</>, so
> >>> +C</../../foo> will be normalized to C</foo>.
> >>> +
> >>> +Throws an exception if C<$path> is C<undef> or the call to C<canonpath> failed.
> >>> +
> >>> +=cut
> >>> +
> >>> +sub path_normalize : prototype($) {
> >>> + my ($path) = @_;
> >>> +
> >>> + croak "\$path is undef" if !defined($path);
> >>> +
> >>> + my $cleaned_path = eval {
> >>> + File::Spec->canonpath($path);
> >>> + };
> >>> +
> >>
> >> Style nit: blank lines between eval and using $@ are better avoided
> >> IMHO. I'd also have the eval expression be a single line, but no strong
> >> feelings.
> >
> > Could you perhaps elaborate why, please?
> >
>
> Because new code gets added more easily in between. I've seen that
> happen before.
Ah, okay! Sure, then I'll change it. At first I feared that there was
some (--> yet another) obscure Perl edge case I didn't know about. :P
>
> ---snip 8<---
>
> >>> +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 '';
> >>> + return $other if path_is_absolute($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)" >>>.
> >>> +
> >>
> >> Why have this alias? The name suggests it would behave like an inverse
> >> to path_push(), but it does not, because of the normalization of
> >> path_parent(). So I'd rather not have it or have it be a non-normalizing
> >> version (but maybe not worth it) to avoid surprises.
> >
> > Could you please elaborate what you mean regarding the normalization of
> > path_parent()?
>
> I just mean push "." followed by pop is not the same as you start with.
>
> >
> > path_parent() (or path_pop()) will only normalize as much as it needs to
> > in order to remove the last path component and get to the one that
> > precedes that:
> >
> > my $p = "foo/././bar/././baz/./.";
> >
> > $p = PVE::Path::path_parent($p): # or path_pop()
> > # $p is now "foo/././bar"
> >
> > path_push() does actually behave like an inverse if you include the
> > redundant stuff:
> >
> > $p = PVE::Path::path_push($p, "././baz/./.")
> > # $p is now "foo/././bar/././baz/./." again
> >
> > It's not a complete inverse, that's true (as in, it's not bijective ;P),
> > because you can't replicate the example above with a path like
> > "foo///bar///baz" since you can't push "///baz" onto "foo///bar"
> > ("///baz" is treated as an absolute path).
> >
> > I think a non-normalizing version wouldn't really be that nice to use;
> > one would have to constantly remember to call path_normalize()
> > beforehand to actually get the desired result (i.e. getting the parent
> > directory).
>
> Agreed.
>
> >
> > I can just remove the alias if you prefer; it's not equivalent to Rust's
> > PathBuf::pop() [pop] and if it's a source of confusion, we can probably
> > do without.
> >
> > [pop]: https://doc.rust-lang.org/std/path/struct.PathBuf.html#method.pop
> >
>
> I see where the inspiration comes from then :) I get why Rust has both,
> because one is for Path and the other for PathBuf. And since they are
> essentially the same operation, fine by me to keep this alias.
>
> >>
> >>> +=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 '.')
> >>> + ) {
> >>
> >> Style nit: this conditional fits well into 100 characters, so can be one
> >> line instead of four
> >
> > Fair point, but I prefer to have it a little more readable here, and
> > it's still in line with our style guide. :P
>
> Personally, I find this version "more noisy" to read, because of the
> split, but no hard feelings :)
>
> ---snip 8<---
>
> >>> +=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)
> >>> +
> >>
> >> Hmm, looking at this and path_with_file_suffix{,es}(), would it maybe be
> >> nicer to have a single
> >> path_with_file_name_from_parts($path, $prefix, @suffixes)
> >> function instead of these? Would seem more natural/straightforward to
> >> me. The implementations are rather involved IMHO compared to how useful
> >> the functions are. It's very easy to get the behavior for the (I suspect
> >> rather uncommon) case of where you want to replace only prefix or
> >> suffix(es) without already knowing the other. Just need to call
> >> path_file_parts() first. Or did you take inspiration from somewhere else
> >> for these?
> >
> > I'll have to disagree here precisely because having to call
> > path_file_parts() first is IMO tedious from the caller's perspective. In
> > many cases I rarely care about all of the individual parts; instead I
> > just e.g. want to rename a file while keeping the suffix(es), or I want to
> > trim off the last suffix of something like "archive.tar.gz" because I'm
> > decompressing it to "archive.tar" or similar.
> >
> > In other words, in a lot of cases I just want to perform one individual
> > operation, and the path_file_* and path_with_file_* functions represent
> > all those individual operations as concisely as possible. The burden of
> > "figuring out what to do" shouldn't be given to the caller in such
> > cases.
> >
> > Regarding inspiration: These functions were inspired after having read a
> > related Rust GitHub issue [issue] where a lot of this was discussed as
> > well.
> >
> > That issue also suggests having some kind of iterator for file parts,
> > that other methods of std::path::Path can be based on; this is actually
> > what led me to adding path_file_parts() below. You have access to the
> > individual parts there and can just join() them to the file name. That
> > would be very similar to the path_with_file_name_from_parts() function
> > you suggested. :P
> >
> > [issue]: https://github.com/rust-lang/rust/issues/86319
> >
>
> Okay, thank you for elaborating! Maybe such calls are more common than I
> think.
You're welcome!
Also thanks for the thorough review, it's much appreciated :) I'll see
if I can send out a v4 soon enough.
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread
* [pve-devel] [PATCH v3 pve-common 02/12] test: add directory for tests of PVE::Path module
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 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; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 03/12] test: add tests for path_is_absolute and path_is_relative of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 01/12] introduce PVE::Path Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 02/12] test: add directory for tests of PVE::Path module Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 04/12] test: add tests for path_components " Max Carrara
` (8 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 04/12] test: add tests for path_components of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (2 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 03/12] test: add tests for path_is_absolute and path_is_relative of PVE::Path Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 05/12] test: add tests for path_join " Max Carrara
` (7 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 UTC (permalink / raw)
To: pve-devel
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 05/12] test: add tests for path_join of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (3 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 04/12] test: add tests for path_components " Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 06/12] test: add tests for path_push " Max Carrara
` (6 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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..1a2eb72
--- /dev/null
+++ b/test/Path/path_join_tests.pl
@@ -0,0 +1,310 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $cases = [
+ {
+ name => "no components",
+ components => [],
+ joined => "",
+ },
+ {
+ name => "one component, relative",
+ components => ["foo"],
+ joined => "foo",
+ },
+ {
+ name => "one component, with root",
+ components => ["/", "foo"],
+ joined => "/foo",
+ },
+ {
+ name => "current path reference",
+ components => ["."],
+ joined => ".",
+ },
+ {
+ name => "multiple components, relative",
+ components => ["foo", "bar", "baz"],
+ joined => "foo/bar/baz",
+ },
+ {
+ name => "multiple components, with root",
+ components => ["/", "foo", "bar", "baz"],
+ joined => "/foo/bar/baz",
+ },
+ {
+ name => "multiple components, root inbetween",
+ components => ["foo", "bar", "/", "baz", "quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "multiple components, with root, root inbetween",
+ components => ["/", "foo", "bar", "/", "baz", "quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "multiple components, root at end",
+ components => ["foo", "bar", "baz", "/"],
+ joined => "/",
+ },
+ {
+ name => "multiple components, with root, root at end",
+ components => ["/", "foo", "bar", "baz", "/"],
+ joined => "/",
+ },
+ {
+ name => "multiple components, current path references inbetween",
+ components => ["foo", ".", "bar", ".", ".", "baz"],
+ joined => "foo/./bar/././baz",
+ },
+ {
+ name => "multiple components, with root, current path references inbetween",
+ components => ["/", "foo", ".", "bar", ".", ".", "baz"],
+ joined => "/foo/./bar/././baz",
+ },
+ {
+ name => "multiple components, current path references at end",
+ components => ["foo", "bar", ".", "."],
+ joined => "foo/bar/./.",
+ },
+ {
+ name => "multiple components, with root, current path references at end",
+ components => ["/", "foo", "bar", ".", "."],
+ joined => "/foo/bar/./.",
+ },
+ {
+ name => "multiple components, current path reference at start",
+ components => [".", "foo", "bar"],
+ joined => "./foo/bar",
+ },
+ {
+ name => "multiple components, parent path references inbetween",
+ components => ["foo", "..", "bar", "..", "..", "baz"],
+ joined => "foo/../bar/../../baz",
+ },
+ {
+ name => "multiple components, with root, parent path references inbetween",
+ components => ["/", "foo", "..", "bar", "..", "..", "baz"],
+ joined => "/foo/../bar/../../baz",
+ },
+ {
+ name => "multiple components, parent path references at end",
+ components => ["foo", "bar", "..", ".."],
+ joined => "foo/bar/../..",
+ },
+ {
+ name => "multiple components, with root, parent path references at end",
+ components => ["/", "foo", "bar", "..", ".."],
+ joined => "/foo/bar/../..",
+ },
+ {
+ name => "multiple components, parent path reference at start",
+ components => ["..", "foo", "bar"],
+ joined => "../foo/bar",
+ },
+ {
+ name => "relative paths (2)",
+ components => ["foo/bar", "baz/quo"],
+ joined => "foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (3)",
+ components => ["foo/bar", "baz/quo", "one/two/three"],
+ joined => "foo/bar/baz/quo/one/two/three",
+ },
+ {
+ name => "relative paths (2) with root inbetween",
+ components => ["foo/bar", "/","baz/quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "relative paths (3) with root inbetween",
+ components => ["foo/bar", "/","baz/quo", "/", "one/two/three"],
+ joined => "/one/two/three",
+ },
+ {
+ name => "absolute paths (2)",
+ components => ["/foo/bar", "/baz/quo"],
+ joined => "/baz/quo",
+ },
+ {
+ name => "relative paths (2, not normalized)",
+ components => ["foo/.///.//.///bar", "baz/.////./quo"],
+ joined => "foo/.///.//.///bar/baz/.////./quo",
+ },
+ {
+ name => "relative paths (3, not normalized)",
+ components => ["foo/.///.//.///bar", "baz/.////./quo", "one/two//three///"],
+ joined => "foo/.///.//.///bar/baz/.////./quo/one/two//three///",
+ },
+ {
+ name => "relative paths (2), trailing slashes",
+ components => ["foo/bar/", "baz/quo/"],
+ joined => "foo/bar/baz/quo/",
+ },
+ {
+ name => "relative paths (3), trailing slashes",
+ components => ["foo/bar/", "baz/quo", "one/two/three/"],
+ joined => "foo/bar/baz/quo/one/two/three/",
+ },
+ {
+ name => "relative path and empty path at end",
+ components => ["foo/bar", ""],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty paths at end (3)",
+ components => ["foo/bar", "", "", ""],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty path at start",
+ components => ["", "foo/bar"],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative path and empty paths at start (3)",
+ components => ["", "", "", "foo/bar"],
+ joined => "foo/bar",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2)",
+ components => ["", "", "foo/bar", "", "", "baz/quo", "", ""],
+ joined => "foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2), with root at start",
+ components => ["/", "", "", "foo/bar", "", "", "baz/quo", "", ""],
+ joined => "/foo/bar/baz/quo",
+ },
+ {
+ name => "relative paths (2) and empty paths at start, middle, end (2), with root in middle",
+ components => ["", "", "foo/bar", "", "/", "", "baz/quo", "", ""],
+ joined => "/baz/quo",
+ },
+ {
+ name => "undef among paths",
+ components => ["foo", "bar/baz", undef, "quo", "qux"],
+ joined => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_join : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_join: " . $case->{name};
+
+ my $joined = eval { PVE::Path::path_join($case->{components}->@*); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to join components of path:\n$@");
+ return;
+ }
+
+ if (!is($joined, $case->{joined}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{joined}));
+ diag("=== Got ===");
+ diag(explain($joined));
+ }
+
+ return;
+}
+
+# This is basically the same as above, but checks whether the joined path
+# is still the same when normalized after splitting and joining it again.
+sub test_path_join_consistent : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_join (consistency): " . $case->{name};
+
+ my $joined = eval { PVE::Path::path_join($case->{components}->@*); };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to join components of path:\n$@");
+ return;
+ }
+
+ my $joined_again = eval {
+ my @components = PVE::Path::path_components($joined);
+ PVE::Path::path_join(@components);
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to re-join previously joined path:\n$@");
+ return;
+ }
+
+ my $normalized = eval { PVE::Path::path_normalize($joined_again); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to normalize re-joined path:\n$@");
+ return;
+ }
+
+ my $expected_normalized = eval { PVE::Path::path_normalize($case->{joined}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to normalize expected path:\n$@");
+ return;
+ }
+
+ if (!is($normalized, $expected_normalized, $name)) {
+ diag("=== Expected ===");
+ diag(explain($expected_normalized));
+ diag("=== Got ===");
+ diag(explain($normalized));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_join,
+ \&test_path_join_consistent,
+ ];
+
+ plan(tests => scalar($cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($cases->@*) {
+ for my $test_sub ($test_subs->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ $test_sub->($case);
+ };
+ warn "$@\n" if $@;
+ }
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 06/12] test: add tests for path_push of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (4 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 05/12] test: add tests for path_join " Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 07/12] test: add tests for path_parent " Max Carrara
` (5 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 UTC (permalink / raw)
To: pve-devel
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
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..3b006a0
--- /dev/null
+++ b/test/Path/path_push_tests.pl
@@ -0,0 +1,159 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $cases = [
+ {
+ name => "push empty onto empty path",
+ path => "",
+ to_push => "",
+ pushed => "",
+ },
+ {
+ name => "push empty onto root",
+ path => "/",
+ to_push => "",
+ pushed => "/",
+ },
+ {
+ name => "push single component onto empty path",
+ path => "",
+ to_push => "foo",
+ pushed => "foo",
+ },
+ {
+ name => "push single component onto root",
+ path => "/",
+ to_push => "foo",
+ pushed => "/foo",
+ },
+ {
+ name => "push single component onto single component",
+ path => "foo",
+ to_push => "bar",
+ pushed => "foo/bar",
+ },
+ {
+ name => "push single component onto single component with trailing slash",
+ path => "foo/",
+ to_push => "bar",
+ pushed => "foo/bar",
+ },
+ {
+ name => "push single component with trailing slath onto single component",
+ path => "foo",
+ to_push => "bar/",
+ pushed => "foo/bar/",
+ },
+ {
+ name => "push single component with trailing slash"
+ . " onto single component with trailing slash",
+ path => "foo/",
+ to_push => "bar/",
+ pushed => "foo/bar/",
+ },
+ {
+ name => "push relative path onto relative path",
+ path => "foo/bar",
+ to_push => "baz/quo",
+ pushed => "foo/bar/baz/quo",
+ },
+ {
+ name => "push relative path onto relative path with trailing slash",
+ path => "foo/bar/",
+ to_push => "baz/quo",
+ pushed => "foo/bar/baz/quo",
+ },
+ {
+ name => "push relative path with trailing slash onto relative path",
+ path => "foo/bar",
+ to_push => "baz/quo/",
+ pushed => "foo/bar/baz/quo/",
+ },
+ {
+ name => "push relative path with trailing slash onto relative path with trailing slash",
+ path => "foo/bar/",
+ to_push => "baz/quo/",
+ pushed => "foo/bar/baz/quo/",
+ },
+ {
+ name => "push root onto relative path",
+ path => "foo/bar",
+ to_push => "/",
+ pushed => "/",
+ },
+ {
+ name => "push root onto absolute path",
+ path => "/foo/bar",
+ to_push => "/",
+ pushed => "/",
+ },
+ {
+ name => "push absolute path onto relative path",
+ path => "foo/bar",
+ to_push => "/baz/quo",
+ pushed => "/baz/quo",
+ },
+ {
+ name => "push absolute path onto absolute path",
+ path => "/foo/bar",
+ to_push => "/baz/quo",
+ pushed => "/baz/quo",
+ },
+];
+
+sub test_path_push : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_push: " . $case->{name};
+
+ my $pushed = eval { PVE::Path::path_push($case->{path}, $case->{to_push}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to push onto path:\n$@");
+ return;
+ }
+
+ if (!is($pushed, $case->{pushed}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{pushed}));
+ diag("=== Got ===");
+ diag(explain($pushed));
+ }
+
+ return;
+}
+
+
+sub main : prototype() {
+ my $test_subs = [
+ \&test_path_push,
+ ];
+
+ plan(tests => scalar($cases->@*) * scalar($test_subs->@*));
+
+ for my $case ($cases->@*) {
+ for my $test_sub ($test_subs->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ $test_sub->($case);
+ };
+ warn "$@\n" if $@;
+ }
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 07/12] test: add tests for path_parent of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (5 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 06/12] test: add tests for path_push " Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 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; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 UTC (permalink / raw)
To: pve-devel
What's important to note is that among the cases added are also some
that specifically account for Perl's File::Spec->canonpath treating
paths consisting of a single component that is neither "/" or "." as
the same. This means that e.g. "foo" and "./foo" are both the same
(canonpath returns "foo").
Because canonpath also returns "" instead of "." for the empty path
"", the behaviour of path_parent should be consistent with that of
Perl's canonpath (and in turn therefore also for path_normalize, which
wraps canonpath).
The path_parent function should otherwise work the same as Rust's
std::path::Path::parent [1]. The discrepancies as mentioned above are
checked for by the tests introduced here.
[1]: https://doc.rust-lang.org/std/path/struct.Path.html#method.parent
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_parent_tests.pl | 153 +++++++++++++++++++++++++++++++++
2 files changed, 154 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..9dfa301
--- /dev/null
+++ b/test/Path/path_parent_tests.pl
@@ -0,0 +1,153 @@
+#!/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 => "",
+ },
+ # Why? Because File::Spec->canonpath interprets "./foo" and "foo"
+ # as the same thing, and the parent of "./foo" is "."
+ {
+ name => "single component, relative",
+ path => "foo",
+ parent => ".",
+ },
+ # Same as above!
+ {
+ 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, 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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 08/12] test: add tests for path_starts_with, path_ends_with, path_equals
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (6 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 07/12] test: add tests for path_parent " Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 09/12] test: add tests for file path operation functions of PVE::Path Max Carrara
` (3 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 09/12] test: add tests for file path operation functions of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (7 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 08/12] test: add tests for path_starts_with, path_ends_with, path_equals Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 10/12] test: add tests for path_normalize " Max Carrara
` (2 subsequent siblings)
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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.
That's why some of the cases added here account for weird file names,
files with more than two suffixes, etc. The functions above must of
course always work in a consistent manner, even if a file starts with
leading dots or has an arbitrarily high number of suffixes.
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v2 --> v3:
* Adapt code accordingly since path_file_suffixes and path_file_parts
don't return a list ref in scalar context anymore
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_file_ops_tests.pl | 1226 ++++++++++++++++++++++++++++++
2 files changed, 1227 insertions(+)
create mode 100755 test/Path/path_file_ops_tests.pl
diff --git a/test/Path/Makefile b/test/Path/Makefile
index 627dc09..9dcb878 100644
--- a/test/Path/Makefile
+++ b/test/Path/Makefile
@@ -1,6 +1,7 @@
TESTS = \
path_comparison_tests.pl \
path_components_tests.pl \
+ path_file_ops_tests.pl \
path_is_absolute_relative_tests.pl \
path_join_tests.pl \
path_parent_tests.pl \
diff --git a/test/Path/path_file_ops_tests.pl b/test/Path/path_file_ops_tests.pl
new file mode 100755
index 0000000..a3a7a59
--- /dev/null
+++ b/test/Path/path_file_ops_tests.pl
@@ -0,0 +1,1226 @@
+#!/usr/bin/env perl
+
+use lib '../../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use PVE::Path;
+
+my $path_file_part_cases = [
+ {
+ name => "empty path",
+ path => "",
+ file_name => undef,
+ file_prefix => undef,
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => [],
+ },
+ {
+ name => "root",
+ path => "/",
+ file_name => undef,
+ file_prefix => undef,
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => [],
+ },
+ {
+ name => "file without suffixes",
+ path => "foo",
+ file_name => "foo",
+ file_prefix => "foo",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["foo"],
+ },
+ {
+ name => "file without suffixes, with root",
+ path => "/foo",
+ file_name => "foo",
+ file_prefix => "foo",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["foo"],
+ },
+ {
+ name => "file with suffixes (1)",
+ path => "foo.txt",
+ file_name => "foo.txt",
+ file_prefix => "foo",
+ file_suffix => "txt",
+ file_suffixes => ["txt"],
+ file_parts => ["foo", "txt"],
+ },
+ {
+ name => "file with suffixes (3)",
+ path => "foo.txt.zip.zst",
+ file_name => "foo.txt.zip.zst",
+ file_prefix => "foo",
+ file_suffix => "zst",
+ file_suffixes => ["txt", "zip", "zst"],
+ file_parts => ["foo", "txt", "zip", "zst"],
+ },
+ {
+ name => "file with suffixes (1), with root",
+ path => "/foo.txt",
+ file_name => "foo.txt",
+ file_prefix => "foo",
+ file_suffix => "txt",
+ file_suffixes => ["txt"],
+ file_parts => ["foo", "txt"],
+ },
+ {
+ name => "file with suffixes (3), with root",
+ path => "/foo.txt.zip.zst",
+ file_name => "foo.txt.zip.zst",
+ file_prefix => "foo",
+ file_suffix => "zst",
+ file_suffixes => ["txt", "zip", "zst"],
+ file_parts => ["foo", "txt", "zip", "zst"],
+ },
+ {
+ name => "/etc/resolv.conf - simple file with single dir",
+ path => "/etc/resolv.conf",
+ file_name => "resolv.conf",
+ file_prefix => "resolv",
+ file_suffix => "conf",
+ file_suffixes => ["conf"],
+ file_parts => ["resolv", "conf"],
+ },
+ {
+ name => "/etc/pve/firewall/cluster.fw - long path",
+ path => "/etc/pve/firewall/cluster.fw",
+ file_name => "cluster.fw",
+ file_prefix => "cluster",
+ file_suffix => "fw",
+ file_suffixes => ["fw"],
+ file_parts => ["cluster", "fw"],
+ },
+ {
+ name => "/tmp/archive.tar.gz - file with two suffixes",
+ path => "/tmp/archive.tar.gz",
+ file_name => "archive.tar.gz",
+ file_prefix => "archive",
+ file_suffix => "gz",
+ file_suffixes => ["tar", "gz"],
+ file_parts => ["archive", "tar", "gz"],
+ },
+ {
+ name => "/home/bob/.bash_history - hidden file",
+ path => "/home/bob/.bash_history",
+ file_name => ".bash_history",
+ file_prefix => ".bash_history",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => [".bash_history"],
+ },
+ {
+ name => "/home/bob/..foobar - file prefixed with double dot",
+ path => "/home/bob/..foobar",
+ file_name => "..foobar",
+ file_prefix => "..foobar",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["..foobar"],
+ },
+ {
+ name => "/home/bob/...foo...bar...baz... - wacky but legal file name",
+ path => "/home/bob/...foo...bar...baz...",
+ file_name => "...foo...bar...baz...",
+ file_prefix => "...foo",
+ file_suffix => "",
+ file_suffixes => ["", "", "bar", "", "", "baz", "", "", ""],
+ file_parts => ["...foo", "", "", "bar", "", "", "baz", "", "", ""],
+ },
+ {
+ name => "/home/bob/...... - file name consisting solely of dots",
+ path => "/home/bob/......",
+ file_name => "......",
+ file_prefix => "......",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["......"],
+ },
+ {
+ name => "/home/bob/. - current path reference",
+ path => "/home/bob/.",
+ file_name => "bob",
+ file_prefix => "bob",
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => ["bob"],
+ },
+ {
+ name => "/home/bob/.. - parent path reference",
+ path => "/home/bob/..",
+ file_name => undef,
+ file_prefix => undef,
+ file_suffix => undef,
+ file_suffixes => [],
+ file_parts => [],
+ },
+];
+
+sub test_path_file_name : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_name: " . $case->{name};
+
+ my $file_name = eval { PVE::Path::path_file_name($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file name of path:\n$@");
+ return;
+ }
+
+ if (!is($file_name, $case->{file_name}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_name}));
+ diag("=== Got ===");
+ diag(explain($file_name));
+ }
+
+ return;
+}
+
+sub test_path_file_prefix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_prefix: " . $case->{name};
+
+ my $file_prefix = eval { PVE::Path::path_file_prefix($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file prefix of path:\n$@");
+ return;
+ }
+
+ if (!is($file_prefix, $case->{file_prefix}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_prefix}));
+ diag("=== Got ===");
+ diag(explain($file_prefix));
+ }
+
+ return;
+}
+
+sub test_path_file_suffix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_suffix: " . $case->{name};
+
+ my $file_suffix = eval { PVE::Path::path_file_suffix($case->{path}); };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file suffix of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_suffix, $case->{file_suffix}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_suffix}));
+ diag("=== Got ===");
+ diag(explain($file_suffix));
+ }
+
+ return;
+}
+
+sub test_path_file_suffixes : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_suffixes: " . $case->{name};
+
+ my $file_suffixes = eval {
+ my @suffixes = PVE::Path::path_file_suffixes($case->{path});
+ \@suffixes;
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file suffixes of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_suffixes, $case->{file_suffixes}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_suffixes}));
+ diag("=== Got ===");
+ diag(explain($file_suffixes));
+ }
+
+ return;
+}
+
+sub test_path_file_parts : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_file_parts: " . $case->{name};
+
+ my $file_parts = eval {
+ my @parts = PVE::Path::path_file_parts($case->{path});
+ \@parts;
+ };
+
+ if ($@) {
+ fail($name);
+ diag("Failed to get file parts of path:\n$@");
+ return;
+ }
+
+ if (!is_deeply($file_parts, $case->{file_parts}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{file_parts}));
+ diag("=== Got ===");
+ diag(explain($file_parts));
+ }
+
+ return;
+}
+
+my $path_with_file_name_cases = [
+ {
+ name => "no path, no file name",
+ path => "",
+ file_name => "",
+ expected => "",
+ },
+ {
+ name => "root, no file name",
+ path => "/",
+ file_name => "",
+ expected => "/",
+ },
+ {
+ name => "no path, file name",
+ path => "",
+ file_name => "foo",
+ expected => "foo",
+ },
+ {
+ name => "root, file name",
+ path => "/",
+ file_name => "foo",
+ expected => "/foo",
+ },
+ {
+ name => "single path component, no file name",
+ path => "foo",
+ file_name => "",
+ expected => "",
+ },
+ {
+ name => "single path component, absolute, no file name",
+ path => "/foo",
+ file_name => "",
+ expected => "/",
+ },
+ {
+ name => "single path component, file name",
+ path => "foo",
+ file_name => "bar",
+ expected => "bar",
+ },
+ {
+ name => "single path component, absolute, file name",
+ path => "/foo",
+ file_name => "bar",
+ expected => "/bar",
+ },
+ {
+ name => "multiple path components, no file name",
+ path => "foo/bar/baz",
+ file_name => "",
+ expected => "foo/bar",
+ },
+ {
+ name => "multiple path components, absolute, no file name",
+ path => "/foo/bar/baz",
+ file_name => "",
+ expected => "/foo/bar",
+ },
+ {
+ name => "multiple path components, file name",
+ path => "foo/bar/baz",
+ file_name => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components, absolute, file name",
+ path => "/foo/bar/baz",
+ file_name => "qux",
+ expected => "/foo/bar/qux",
+ },
+ {
+ name => "multiple path components with current path reference, no file name",
+ path => "foo/bar/baz/.",
+ file_name => "",
+ expected => "foo/bar",
+ },
+ {
+ name => "multiple path components with current path reference, file name",
+ path => "foo/bar/baz/.",
+ file_name => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components with parent path reference, no file name",
+ path => "foo/bar/baz/..",
+ file_name => "",
+ expected => "foo/bar/baz",
+ },
+ {
+ name => "multiple path components with parent path reference, file name",
+ path => "foo/bar/baz/..",
+ file_name => "qux",
+ expected => "foo/bar/baz/qux",
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/bar.txt",
+ path => "/home/bob/foo.txt",
+ file_name => "bar.txt",
+ expected => "/home/bob/bar.txt",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/backup.tar.zst",
+ path => "/tmp/archive.tar.gz",
+ file_name => "backup.tar.zst",
+ expected => "/tmp/backup.tar.zst",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...bar.csv",
+ path => "/home/bob/...foo.txt",
+ file_name => "...bar.csv",
+ expected => "/home/bob/...bar.csv",
+ },
+ {
+ name => "file name with path separator",
+ path => "foo/bar/baz",
+ file_name => "quo/qux",
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_name : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_name: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_name($case->{path}, $case->{file_name});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file name of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+my $path_with_file_prefix_cases = [
+ {
+ name => "no path, no prefix",
+ path => "",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "root, no prefix",
+ path => "/",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "no path, prefix",
+ path => "",
+ prefix => "foo",
+ expected => undef,
+ },
+ {
+ name => "root, prefix",
+ path => "/",
+ prefix => "foo",
+ expected => undef,
+ },
+ {
+ name => "single path component, no prefix",
+ path => "foo",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "single path component, absolute, no prefix",
+ path => "/foo",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "single path component, prefix",
+ path => "foo",
+ prefix => "bar",
+ expected => "bar",
+ },
+ {
+ name => "single path component, absolute, prefix",
+ path => "/foo",
+ prefix => "bar",
+ expected => "/bar",
+ },
+ {
+ name => "multiple path components, no prefix",
+ path => "foo/bar/baz",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "multiple path components, absolute, no prefix",
+ path => "/foo/bar/baz",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "multiple path components, prefix",
+ path => "foo/bar/baz",
+ prefix => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components, absolute, prefix",
+ path => "/foo/bar/baz",
+ prefix => "qux",
+ expected => "/foo/bar/qux",
+ },
+ {
+ name => "multiple path components with current path reference, no prefix",
+ path => "foo/bar/baz/.",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "multiple path components with current path reference, prefix",
+ path => "foo/bar/baz/.",
+ prefix => "qux",
+ expected => "foo/bar/qux",
+ },
+ {
+ name => "multiple path components with parent path reference, no prefix",
+ path => "foo/bar/baz/..",
+ prefix => "",
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent path reference, prefix",
+ path => "foo/bar/baz/..",
+ prefix => "qux",
+ expected => undef,
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/bar.txt",
+ path => "/home/bob/foo.txt",
+ prefix => "bar",
+ expected => "/home/bob/bar.txt",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/backup.tar.gz",
+ path => "/tmp/archive.tar.gz",
+ prefix => "backup",
+ expected => "/tmp/backup.tar.gz",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...bar.txt",
+ path => "/home/bob/...foo.txt",
+ prefix => "...bar",
+ expected => "/home/bob/...bar.txt",
+ },
+ {
+ name => "prefix with path separator",
+ path => "foo/bar/baz",
+ prefix => "quo/qux",
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "prefix ends with dot",
+ path => "foo/bar/baz",
+ prefix => "quo.",
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_prefix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_prefix: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_prefix($case->{path}, $case->{prefix});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file prefix of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+my $path_with_file_suffix_cases = [
+ {
+ name => "no path, empty suffix",
+ path => "",
+ suffix => undef,
+ expected => undef,
+ },
+ {
+ name => "root, empty suffix",
+ path => "/",
+ suffix => undef,
+ expected => undef,
+ },
+ {
+ name => "no path, suffix",
+ path => "",
+ suffix => "foo",
+ expected => undef,
+ },
+ {
+ name => "root, suffix",
+ path => "/",
+ suffix => "foo",
+ expected => undef,
+ },
+ {
+ name => "no path, undef suffix",
+ path => "",
+ suffix => undef,
+ expected => undef,
+ },
+ {
+ name => "root, undef suffix",
+ path => "/",
+ suffix => undef,
+ expected => undef,
+ },
+ {
+ name => "single path component, empty suffix",
+ path => "foo",
+ suffix => "",
+ expected => "foo.",
+ },
+ {
+ name => "single path component, absolute, empty suffix",
+ path => "/foo",
+ suffix => "",
+ expected => "/foo.",
+ },
+ {
+ name => "single path component, suffix",
+ path => "foo",
+ suffix => "bar",
+ expected => "foo.bar",
+ },
+ {
+ name => "single path component, absolute, suffix",
+ path => "/foo",
+ suffix => "bar",
+ expected => "/foo.bar",
+ },
+ {
+ name => "single path component, undef suffix",
+ path => "foo",
+ suffix => undef,
+ expected => "foo",
+ },
+ {
+ name => "single path component, absolute, undef suffix",
+ path => "/foo",
+ suffix => undef,
+ expected => "/foo",
+ },
+ {
+ name => "multiple path components, empty suffix",
+ path => "foo/bar/baz",
+ suffix => "",
+ expected => "foo/bar/baz.",
+ },
+ {
+ name => "multiple path components, absolute, empty suffix",
+ path => "/foo/bar/baz",
+ suffix => "",
+ expected => "/foo/bar/baz.",
+ },
+ {
+ name => "multiple path components, suffix",
+ path => "foo/bar/baz",
+ suffix => "qux",
+ expected => "foo/bar/baz.qux",
+ },
+ {
+ name => "multiple path components, absolute, suffix",
+ path => "/foo/bar/baz",
+ suffix => "qux",
+ expected => "/foo/bar/baz.qux",
+ },
+ {
+ name => "multiple path components, undef suffix",
+ path => "foo/bar/baz",
+ suffix => undef,
+ expected => "foo/bar/baz",
+ },
+ {
+ name => "multiple path components, absolute, undef suffix",
+ path => "/foo/bar/baz",
+ suffix => undef,
+ expected => "/foo/bar/baz",
+ },
+ {
+ name => "multiple path components with current path reference, empty suffix",
+ path => "foo/bar/baz/.",
+ suffix => "",
+ expected => "foo/bar/baz.",
+ },
+ {
+ name => "multiple path components with current path reference, suffix",
+ path => "foo/bar/baz/.",
+ suffix => "qux",
+ expected => "foo/bar/baz.qux",
+ },
+ {
+ name => "multiple path components with current path reference, undef suffix",
+ path => "foo/bar/baz/.",
+ suffix => undef,
+ expected => "foo/bar/baz/.",
+ },
+ {
+ name => "multiple path components with parent path reference, empty suffix",
+ path => "foo/bar/baz/..",
+ suffix => "",
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent path reference, suffix",
+ path => "foo/bar/baz/..",
+ suffix => "qux",
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent path reference, undef suffix",
+ path => "foo/bar/baz/..",
+ suffix => "qux",
+ expected => undef,
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/foo.mp4",
+ path => "/home/bob/foo.txt",
+ suffix => "mp4",
+ expected => "/home/bob/foo.mp4",
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/foo.",
+ path => "/home/bob/foo.txt",
+ suffix => "",
+ expected => "/home/bob/foo.",
+ },
+ {
+ name => "/home/bob/foo.txt --> /home/bob/foo",
+ path => "/home/bob/foo",
+ suffix => undef,
+ expected => "/home/bob/foo",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar.zst",
+ path => "/tmp/archive.tar.gz",
+ suffix => "zst",
+ expected => "/tmp/archive.tar.zst",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar.",
+ path => "/tmp/archive.tar.",
+ suffix => "",
+ expected => "/tmp/archive.tar.",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar",
+ path => "/tmp/archive.tar.gz",
+ suffix => undef,
+ expected => "/tmp/archive.tar",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...foo.csv",
+ path => "/home/bob/...foo.txt",
+ suffix => "csv",
+ expected => "/home/bob/...foo.csv",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...foo.",
+ path => "/home/bob/...foo.txt",
+ suffix => "",
+ expected => "/home/bob/...foo.",
+ },
+ {
+ name => "/home/bob/...foo.txt --> /home/bob/...foo",
+ path => "/home/bob/...foo.txt",
+ suffix => undef,
+ expected => "/home/bob/...foo",
+ },
+ {
+ name => "/home/bob/...foo --> /home/bob/...foo.txt",
+ path => "/home/bob/...foo",
+ suffix => "txt",
+ expected => "/home/bob/...foo.txt",
+ },
+ {
+ name => "/home/bob/...foo --> /home/bob/...foo.",
+ path => "/home/bob/...foo",
+ suffix => "",
+ expected => "/home/bob/...foo.",
+ },
+ {
+ name => "/home/bob/...foo --> /home/bob/...foo",
+ path => "/home/bob/...foo",
+ suffix => undef,
+ expected => "/home/bob/...foo",
+ },
+ {
+ name => "/home/bob/...foo. --> /home/bob/...foo.",
+ path => "/home/bob/...foo.",
+ suffix => "",
+ expected => "/home/bob/...foo.",
+ },
+ {
+ name => "/home/bob/...foo. --> /home/bob/...foo.txt",
+ path => "/home/bob/...foo.",
+ suffix => "txt",
+ expected => "/home/bob/...foo.txt",
+ },
+ {
+ name => "/home/bob/...foo. --> /home/bob/...foo",
+ path => "/home/bob/...foo.",
+ suffix => undef,
+ expected => "/home/bob/...foo",
+ },
+ {
+ name => "suffix with path separator",
+ path => "foo/bar/baz",
+ suffix => "quo/qux",
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "suffix contains dot",
+ path => "foo/bar/baz",
+ suffix => "quo.qux",
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_suffix : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_suffix: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_suffix($case->{path}, $case->{suffix});
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file suffix of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+my $path_with_file_suffixes_cases = [
+ {
+ name => "no path, no suffixes",
+ path => "",
+ suffixes => [],
+ expected => undef,
+ },
+ {
+ name => "root, no suffixes",
+ path => "/",
+ suffixes => [],
+ expected => undef,
+ },
+ {
+ name => "no path, suffixes (1)",
+ path => "",
+ suffixes => ["tar"],
+ expected => undef,
+ },
+ {
+ name => "root, suffixes (1)",
+ path => "/",
+ suffixes => ["tar"],
+ expected => undef,
+ },
+ {
+ name => "single path component, no suffixes",
+ path => "foo",
+ suffixes => [],
+ expected => "foo",
+ },
+ {
+ name => "single path component, absolute, no suffixes",
+ path => "/foo",
+ suffixes => [],
+ expected => "/foo",
+ },
+ {
+ name => "single path component, suffixes (1)",
+ path => "foo",
+ suffixes => ["tar"],
+ expected => "foo.tar",
+ },
+ {
+ name => "single path component, absolute, suffixes (1)",
+ path => "/foo",
+ suffixes => ["tar"],
+ expected => "/foo.tar",
+ },
+ {
+ name => "single path component, suffixes (3)",
+ path => "foo",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "foo.tar.zst.bak",
+ },
+ {
+ name => "single path component, absolute, suffixes (3)",
+ path => "/foo",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "/foo.tar.zst.bak",
+ },
+ {
+ name => "single path component, suffixes (10)",
+ path => "foo",
+ suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+ expected => "foo.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+ },
+ {
+ name => "single path component, absolute, suffixes (10)",
+ path => "/foo",
+ suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+ expected => "/foo.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+ },
+ {
+ name => "multiple path components, no suffixes",
+ path => "foo/bar/baz",
+ suffixes => [],
+ expected => "foo/bar/baz",
+ },
+ {
+ name => "multiple path components, absolute, no suffixes",
+ path => "/foo/bar/baz",
+ suffixes => [],
+ expected => "/foo/bar/baz",
+ },
+ {
+ name => "multiple path components, suffixes (1)",
+ path => "foo/bar/baz",
+ suffixes => ["tar"],
+ expected => "foo/bar/baz.tar",
+ },
+ {
+ name => "multiple path components, absolute, suffixes (1)",
+ path => "/foo/bar/baz",
+ suffixes => ["tar"],
+ expected => "/foo/bar/baz.tar",
+ },
+ {
+ name => "multiple path components, suffixes (3)",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "foo/bar/baz.tar.zst.bak",
+ },
+ {
+ name => "multiple path components, absolute, suffixes (3)",
+ path => "/foo/bar/baz",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "/foo/bar/baz.tar.zst.bak",
+ },
+ {
+ name => "multiple path components, suffixes (10)",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+ expected => "foo/bar/baz.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+ },
+ {
+ name => "multiple path components, absolute, suffixes (10)",
+ path => "/foo/bar/baz",
+ suffixes => ["tar", "zst", "bak", "gz", "zip", "xz", "lz4", "rar", "br", "lzma"],
+ expected => "/foo/bar/baz.tar.zst.bak.gz.zip.xz.lz4.rar.br.lzma",
+ },
+ {
+ name => "multiple path components with current path reference, no suffixes",
+ path => "foo/bar/baz/.",
+ suffixes => [],
+ expected => "foo/bar/baz/.",
+ },
+ {
+ name => "multiple path components with current path reference, absolute, no suffixes",
+ path => "/foo/bar/baz/.",
+ suffixes => [],
+ expected => "/foo/bar/baz/.",
+ },
+ {
+ name => "multiple path components with current path reference, suffixes (3)",
+ path => "foo/bar/baz/.",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "foo/bar/baz.tar.zst.bak",
+ },
+ {
+ name => "multiple path components with current path reference, absolute, suffixes (3)",
+ path => "/foo/bar/baz/.",
+ suffixes => ["tar", "zst", "bak"],
+ expected => "/foo/bar/baz.tar.zst.bak",
+ },
+ {
+ name => "multiple path components with parent directory reference, no suffixes",
+ path => "foo/bar/baz/..",
+ suffixes => [],
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent directory reference, absolute, no suffixes",
+ path => "/foo/bar/baz/..",
+ suffixes => [],
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent directory reference, suffixes (3)",
+ path => "foo/bar/baz/..",
+ suffixes => ["tar", "zst", "bak"],
+ expected => undef,
+ },
+ {
+ name => "multiple path components with parent directory reference, absolute, suffixes (3)",
+ path => "/foo/bar/baz/..",
+ suffixes => ["tar", "zst", "bak"],
+ expected => undef,
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar.zst",
+ path => "/tmp/archive.tar.gz",
+ suffixes => ["tar", "zst"],
+ expected => "/tmp/archive.tar.zst",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar",
+ path => "/tmp/archive.tar.gz",
+ suffixes => ["tar"],
+ expected => "/tmp/archive.tar",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive.tar.",
+ path => "/tmp/archive.tar.gz",
+ suffixes => ["tar", ""],
+ expected => "/tmp/archive.tar.",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive..",
+ path => "/tmp/archive.tar.gz",
+ suffixes => ["", ""],
+ expected => "/tmp/archive..",
+ },
+ {
+ name => "/tmp/archive.tar --> /tmp/archive.tar.gz",
+ path => "/tmp/archive.tar",
+ suffixes => ["tar", "gz"],
+ expected => "/tmp/archive.tar.gz",
+ },
+ {
+ name => "/tmp/archive --> /tmp/archive.tar.gz",
+ path => "/tmp/archive",
+ suffixes => ["tar", "gz"],
+ expected => "/tmp/archive.tar.gz",
+ },
+ {
+ name => "/tmp/archive.tar.gz --> /tmp/archive",
+ path => "/tmp/archive.tar.gz",
+ suffixes => [],
+ expected => "/tmp/archive",
+ },
+ {
+ name => "/tmp/archive --> /tmp/archive",
+ path => "/tmp/archive",
+ suffixes => [],
+ expected => "/tmp/archive",
+ },
+ {
+ name => "/home/bob/...one...two...three --> /home/bob/...one...foo...bar",
+ path => "/home/bob/...one...two...three",
+ suffixes => ["", "", "foo", "", "", "bar"],
+ expected => "/home/bob/...one...foo...bar",
+ },
+ {
+ name => "suffixes contain a path separator",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "oh/no", "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "suffixes contain a dot",
+ path => "foo/bar/baz",
+ suffixes => ["tar", "oh.no", "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+ {
+ name => "suffixes contain undef",
+ path => "foo/bar/baz",
+ suffixes => ["tar", undef, "zst"],
+ expected => undef,
+ should_throw => 1,
+ },
+];
+
+sub test_path_with_file_suffixes : prototype($) {
+ my ($case) = @_;
+
+ my $name = "path_with_file_suffixes: " . $case->{name};
+
+ my $new_path = eval {
+ PVE::Path::path_with_file_suffixes($case->{path}, $case->{suffixes}->@*);
+ };
+
+ if ($@) {
+ if ($case->{should_throw}) {
+ pass($name);
+ return;
+ }
+
+ fail($name);
+ diag("Failed to replace file suffixes of path:\n$@");
+ return;
+ }
+
+ if (!is($new_path, $case->{expected}, $name)) {
+ diag("=== Expected ===");
+ diag(explain($case->{expected}));
+ diag("=== Got ===");
+ diag(explain($new_path));
+ }
+
+ return;
+}
+
+sub main : prototype() {
+ my $file_part_test_subs = [
+ \&test_path_file_name,
+ \&test_path_file_prefix,
+ \&test_path_file_suffix,
+ \&test_path_file_suffixes,
+ \&test_path_file_parts,
+ ];
+
+ plan(
+ tests => scalar($path_file_part_cases->@*) * scalar($file_part_test_subs->@*)
+ + scalar($path_with_file_name_cases->@*)
+ + scalar($path_with_file_prefix_cases->@*)
+ + scalar($path_with_file_suffix_cases->@*)
+ + scalar($path_with_file_suffixes_cases->@*)
+ );
+
+ for my $case ($path_file_part_cases->@*) {
+ for my $test_sub ($file_part_test_subs->@*) {
+ eval {
+ # suppress warnings here to make output less noisy for certain tests if necessary
+ # local $SIG{__WARN__} = sub {};
+ $test_sub->($case);
+ };
+ warn "$@\n" if $@;
+ }
+ }
+
+ for my $case ($path_with_file_name_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_name($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_prefix_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_prefix($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_suffix_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_suffix($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ for my $case ($path_with_file_suffixes_cases->@*) {
+ eval {
+ # local $SIG{__WARN__} = sub {};
+ test_path_with_file_suffixes($case);
+ };
+ warn "$@\n" if $@;
+ }
+
+ done_testing();
+
+ return;
+}
+
+main();
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 10/12] test: add tests for path_normalize of PVE::Path
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (8 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 09/12] test: add tests for file path operation functions of PVE::Path Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 11/12] introduce PVE::Filesystem Max Carrara
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 wrapping File::Spec->canonpath().
Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
Changes v2 --> v3:
* None
Changes v1 --> v2:
* NEW: Split from patch 02
test/Path/Makefile | 1 +
test/Path/path_normalize_tests.pl | 176 ++++++++++++++++++++++++++++++
2 files changed, 177 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..4d1de24
--- /dev/null
+++ b/test/Path/path_normalize_tests.pl
@@ -0,0 +1,176 @@
+#!/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 => "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] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 11/12] introduce PVE::Filesystem
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (9 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 10/12] test: add tests for path_normalize " Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
2025-01-31 12:44 ` Fiona Ebner
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl Max Carrara
11 siblings, 1 reply; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 v2 --> v3:
* None
Changes v1 --> v2:
* None
src/Makefile | 1 +
src/PVE/Filesystem.pm | 78 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 79 insertions(+)
create mode 100644 src/PVE/Filesystem.pm
diff --git a/src/Makefile b/src/Makefile
index 25bc490..20a0988 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -16,6 +16,7 @@ LIB_SOURCES = \
CpuSet.pm \
Daemon.pm \
Exception.pm \
+ Filesystem.pm \
Format.pm \
INotify.pm \
JSONSchema.pm \
diff --git a/src/PVE/Filesystem.pm b/src/PVE/Filesystem.pm
new file mode 100644
index 0000000..3b06634
--- /dev/null
+++ b/src/PVE/Filesystem.pm
@@ -0,0 +1,78 @@
+=head1 NAME
+
+C<PVE::Filesystem> - Utilities related to filesystem manipulations
+
+=head1 DESCRIPTION
+
+This module implements utilities for manipulating the filesystem. Like
+L<C<PVE::Path>>, this module exists to address certain shortcomings of the Perl
+core modules without relying on third-party solutions / abstractions.
+
+=cut
+
+package PVE::Filesystem;
+
+use strict;
+use warnings;
+
+use Carp qw(carp croak confess);
+use Cwd ();
+
+use Exporter qw(import);
+
+our @EXPORT_OK = qw(
+ fs_cwd
+ fs_canonicalize
+);
+
+=head2 FUNCTIONS
+
+=cut
+
+=head3 fs_getcwd()
+
+Wrapper for C<L<< getcwd()|Cwd/getcwd >>>.
+
+Returns the absolute form of the current working directory.
+
+Unlike the original C<L<< getcwd()|Cwd/getcwd >>>, an exception is thrown if an
+error occurs instead of setting C<$!>.
+
+=cut
+
+sub fs_getcwd : prototype() {
+ my $cwd = Cwd::getcwd();
+
+ croak "failed to get current working directory: $!" if !defined($cwd);
+
+ return $cwd;
+}
+
+=head3 fs_canonicalize($path)
+
+Wrapper for C<L<< abs_path()|Cwd/abs_path >>>.
+
+Returns the canonical, absolute form of the given path with all logical
+components normalized and symlinks resolved.
+
+B<Note:> This requires the path to exist on the filesystem. If you want to
+avoid that, use C<L<< path_normalize()|PVE::Path/"path_normalize($path)" >>>
+instead.
+
+Unlike the original C<L<< abs_path()|Cwd/abs_path >>>, an exception is thrown
+if an error occurs instead of setting C<$!>.
+
+=cut
+
+sub fs_canonicalize : prototype($) {
+ my ($path) = @_;
+
+ croak "\$path is undef" if !defined($path);
+
+ my $canonicalized_path = Cwd::abs_path($path);
+
+ croak "failed to canonicalize path: $!" if !defined($canonicalized_path);
+
+ return $canonicalized_path;
+}
+
--
2.39.5
_______________________________________________
pve-devel mailing list
pve-devel@lists.proxmox.com
https://lists.proxmox.com/cgi-bin/mailman/listinfo/pve-devel
^ permalink raw reply [flat|nested] 20+ messages in thread* [pve-devel] [PATCH v3 pve-common 12/12] debian: introduce package libproxmox-fs-path-utils-perl
2025-01-09 14:48 [pve-devel] [PATCH v3 pve-common 00/12] Introduce and Package PVE::Path & PVE::Filesystem Max Carrara
` (10 preceding siblings ...)
2025-01-09 14:48 ` [pve-devel] [PATCH v3 pve-common 11/12] introduce PVE::Filesystem Max Carrara
@ 2025-01-09 14:48 ` Max Carrara
11 siblings, 0 replies; 20+ messages in thread
From: Max Carrara @ 2025-01-09 14:48 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 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] 20+ messages in thread