From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from firstgate.proxmox.com (firstgate.proxmox.com [IPv6:2a01:7e0:0:424::9]) by lore.proxmox.com (Postfix) with ESMTPS id ED0F81FF16B for ; Thu, 9 Jan 2025 10:56:40 +0100 (CET) Received: from firstgate.proxmox.com (localhost [127.0.0.1]) by firstgate.proxmox.com (Proxmox) with ESMTP id 661F3A3CA; Thu, 9 Jan 2025 10:56:26 +0100 (CET) Mime-Version: 1.0 Date: Thu, 09 Jan 2025 10:56:16 +0100 Message-Id: To: "Wolfgang Bumiller" From: "Max Carrara" X-Mailer: aerc 0.18.2-0-ge037c095a049 References: <20241220185207.519912-1-m.carrara@proxmox.com> <20241220185207.519912-2-m.carrara@proxmox.com> In-Reply-To: X-SPAM-LEVEL: Spam detection results: 0 AWL -2.454 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DMARC_MISSING 0.1 Missing DMARC policy KAM_DMARC_STATUS 0.01 Test Rule for DKIM or SPF Failure with Strict Alignment KAM_SOMETLD_ARE_BAD_TLD 5 .bar, .beauty, .buzz, .cam, .casa, .cfd, .club, .date, .guru, .link, .live, .monster, .online, .press, .pw, .quest, .rest, .sbs, .shop, .stream, .top, .trade, .wiki, .work, .xyz TLD abuse SPF_HELO_NONE 0.001 SPF: HELO does not publish an SPF Record SPF_PASS -0.001 SPF: sender matches SPF record Subject: Re: [pve-devel] [PATCH v2 pve-common 01/12] introduce PVE::Path X-BeenThere: pve-devel@lists.proxmox.com X-Mailman-Version: 2.1.29 Precedence: list List-Id: Proxmox VE development discussion List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-To: Proxmox VE development discussion Cc: pve-devel@lists.proxmox.com Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Errors-To: pve-devel-bounces@lists.proxmox.com Sender: "pve-devel" On Wed Jan 8, 2025 at 3:05 PM CET, Wolfgang Bumiller wrote: > On Fri, Dec 20, 2024 at 07:51:56PM +0100, Max Carrara wrote: > > 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 > > --- > > 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 | 987 ++++++++++++++++++++++++++++++++++++++++++++++++ > > 2 files changed, 988 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..221e662 > > --- /dev/null > > +++ b/src/PVE/Path.pm > > @@ -0,0 +1,987 @@ > > +=head1 NAME > > + > > +C - 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>). > > + > > +=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> 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 and Python's C, > > +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. > > + > > +=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>>. > > + > > +Throws an exception if C<$path> is C. > > + > > +=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. > > + > > +In scalar context, returns a reference to a list. > > + > > +The C<$path> is normalized a little during the parse: > > + > > +=over > > + > > +=item Repeated occurrences of C are removed, so C and C > > +both have C and C 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, C, C, > > +C, etc. all have C and C as components, while > > +C<./foo/bar>, C<./././foo/bar>, C<./foo/./bar/.> have C<.>, C and C > > +as components. > > + > > +=back > > + > > +No other normalization is performed to account for the possibility of symlinks > > +existing. This means that C and C are distinct (because > > +C could be a symlink and thus C isn't its parent). > > + > > +Throws an exception if C<$path> is C. > > + > > +=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; > > ^ This case should probably also be explicitly mentioned in the docs. > (`path_file_name()` also relies on it) Good catch! Will add that. > > > + unshift(@normalized_components, '.') if $has_cur_dir; > > + > > + return @normalized_components if wantarray; > > + return \@normalized_components; > > +} > > + > > + > > +=head3 path_join(@paths) > > + > > +Joins multiple paths together. All kinds of paths are supported. > > + > > +Does not perform any C>>. > > + > > +Throws an exception if any of the passed C<@paths> is C. > > This should probably point to the `path_push` documentation mentioning > the absolute path special case. Another good catch; I agree. > > > + > > +=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>. 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 and C will both become > > +C. > > + > > +B This will I remove components referencing the parent directory, > > +i.e. C<..>. For example, C and C will therefore > > +remain as they are. However, the parent directory of C is C, so > > +C will be normalized to C. > > + > > +Throws an exception if C<$path> is C or the call to C 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 becomes C, but > > +C becomes C. > > + > > +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 becomes C, C becomes C. > > + > > +=item * C becomes C. > > + > > +=item * C becomes C. > > + > > +=item * C becomes C. > > + > > +=item * C is interpreted as C<./foo> and becomes C<.>. This is because Perl's > > +C> interprets C<./foo> and C as the same thing. > > + > > +=item * C and an I result in C being returned. > > + > > +=item * C<.> results in an empty string. > > ^ Like in `path_components()`, this should mention symlinks, since the > parent of `/foo/..` is not necessarily `/foo` in the file system, but > will be here. I agree with this as well; will add a note to the docs. > > > + > > +=back > > + > > +Will raise an exception if C<$path> is C. > > + > > +=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); > > ^ Meh, if we didn't mind normalizing all multi-slash occurrances we could just split on `m@/+@` :S We could, but I'd rather keep it as it is; one can always use path_normalize to get rid of those. > > > + > > + # 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. > > I was never a fan of this. But I guess we cannot change that in rust, so > for the sake of consistency... > > > + > > +Throws an exception if any of the arguments is C. > > + > > +=cut > > + > > +sub path_push : prototype($$) { > > + my ($path, $other) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + croak "\$other is undef" if !defined($other); > > + > > + return $other if path_is_absolute($other); > > + return $path if $other eq ''; > > (^ Could swap the above 2 checks) ACK > > > + > > + my $need_sep = $path ne '' && $path !~ m#/$#; > > + > > + $path .= "/" if $need_sep; > > + $path .= $other; > > + > > + return $path; > > +} > > + > > +=head3 path_pop($path) > > + > > +Alias for C>>. > > + > > +=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 otherwise. > > + > > +If C<$path> is an empty string, C, C<.> or ends with a C<..> component, > > +there is no valid file name. > > + > > +B 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. > > + > > +=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>> > > +and using C>> 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 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 : prototype($) { > > + my ($file_name) = @_; > > + > > + confess "\$file_name is undef" if !defined($file_name); > > + > > + $file_name =~ s|^(\.*[^\.]*)||; > > + my $prefix = $1; > > + > > + # sanity check > > + confess "\$prefix not matched" if !defined($prefix); > > ^ For the above 4 lines you should be able to just test the `=~` > directly: > > confess "..." if $file_name !~ s|^(\.*[^\.]*)||; > > (note =~ -> !~) Ah, another good catch! Will incorporate this in v3 also. > > Would it make sense to instead *match* those parts instead of s// and > return the extension as a 3rd value? I think `path_with_file_prefix()` > could use this instead of building and joining a suffix list? > > No hard feelings, though. Hmm, I'll give it a shot. > > > + > > + return ($prefix, $file_name); > > +} > > + > > +=head3 path_file_prefix($path) > > + > > +Returns the prefix of the file name of the given C<$path>. If the C<$path> does > > +not have a valid file name and thus no prefix, C 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. > > + > > +=cut > > + > > +sub path_file_prefix : prototype($) { > > + my ($path) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + > > + my $file_name = path_file_name($path); > > + return undef if !defined($file_name); > > + > > + my ($prefix, undef) = _path_file_prefix($file_name); > > + return $prefix; > > +} > > + > > +=head3 path_with_file_prefix($path, $prefix) > > + > > +Returns C<$path> with a new C<$prefix>. This is similar to > > +C>>, > > +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 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, or if C<$prefix> > > +contains a path separator (C), ends with C<.>, or is an empty string. > > + > > +=cut > > + > > +sub path_with_file_prefix : prototype($$) { > > + my ($path, $prefix) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + croak "\$prefix is undef" if !defined($prefix); > > + croak "\$prefix contains a path separator" if $prefix =~ m|/|; > > + croak "\$prefix ends with a dot" if $prefix =~ m|\.$|; > > + > > + return undef if $prefix eq ''; > > + return undef if !defined(path_file_name($path)); > > + > > + return $path if $prefix eq ''; > > + > > + my $parent = path_parent($path); > > + > > + # sanity check -- should not happen because we checked for file name, > > + # and the existence of a file name implies there's a parent > > + confess "parent of \$path is undef" if !defined($parent); > > + > > + my @suffixes = path_file_suffixes($path); > > + > > + my $file_name = join(".", $prefix, @suffixes); > > + > > + # 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") > > + # (Done also in path_with_file_name) > > + if ($parent eq '.' && $path !~ m|/|) { > > + return $file_name; > > + } > > + > > + return path_push($parent, $file_name); > > +} > > + > > +my sub _path_file_suffixes : prototype($) { > > + my ($file_name_no_prefix) = @_; > > + > > + confess "\$file_name_no_prefix is undef" if !defined($file_name_no_prefix); > > + > > + # Suffixes are extracted "manually" because join()ing the result of split() > > + # results in a different file name than the original. Let's say you have a > > + # file named "foo.bar.". The correct suffixes would be ("bar", ""). > > + # With split, you get the following: > > + # split(/\./, ".bar.") --> ("", "bar") --> join()ed to "foo..bar" > > + # split(/\./, ".bar.", -1) --> ("", "bar", "") --> join()ed to "foo..bar." > > + my @suffixes = (); > > + while ($file_name_no_prefix =~ s|^(\.[^\.]*)||) { > > + my $suffix = $1; > > + $suffix =~ s|^\.||; > > + push(@suffixes, $suffix); > > + } > > + > > + return @suffixes; > > +} > > + > > +=head3 path_file_suffixes($path) > > + > > +Returns the suffixes of the C<$path>'s file name as a list. If the C<$path> does > > +not have a valid file name, an empty list is returned instead. > > + > > +In scalar context, returns a reference to a list. > > (^ Isn't this a bit awkward?) Well, do you think it is? I've been using that kind of "return style" here and there and have been liking it, but if it's weird to others, I can adapt it. :P > > > + > > +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. > > + > > +=cut > > + > > +sub path_file_suffixes : prototype($) { > > + my ($path) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + > > + my $file_name = path_file_name($path); > > + if (!defined($file_name)) { > > + return wantarray ? () : []; > > + } > > + > > + (undef, $file_name) = _path_file_prefix($file_name); > > + > > + my @suffixes = _path_file_suffixes($file_name); > > + > > + return wantarray ? @suffixes : \@suffixes; > > +} > > + > > +=head3 path_with_file_suffixes($path, @suffixes) > > + > > +Returns C<$path> with new C<@suffixes>. This is similar to > > +C>>, > > +except that the suffixes of the file name are replaced. > > + > > +If the C<$path> does not have a file name, C 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, or > > +if any suffix contains a path separator (C) or a C<.>. > > + > > +=cut > > + > > +sub path_with_file_suffixes : prototype($@) { > > + my ($path, @suffixes) = @_; > > I am questioning a bit the sanity of having "suffixes" throughout this > module instead of simply an "extension" that covers them all and can be > split if needed... > > Do we have/anticipate particular use cases where this is more > convenient? To be really honest, it was 50/50 on the "extension" vs "suffixes" decision. I then opted for suffixes instead, because they seemed to be less ambiguous than an "extension". Let me elaborate. Let's say we have a file called "foo.tar.gz" -- what would its extension be? Some might say that ".tar.gz" is its extension, while some others might say ".gz"; both have different reasonings but aren't necessarily more or less correct than the other. In our case, both you and I would say that ".tar.gz" is the extension, but... Rust's std::path::Path::extension [1] would return "gz" for the above, while C++'s std::filesystem::path::extension [2] returns ".gz" (but they don't have such a case in their docs!). Java has java.nio.file.Path, but conveniently doesn't care about extensions. Kotlin fixest his by adding an "extension" property to that class, which returns "gz" [3]. Python's pathlib is the only one I've seen go the "suffix route" and provides the pathlib.PurePath.suffix and .suffixes methods [4]. This type of approach also came up on the (Rust) tracking issue for Path::file_prefix [5]. When I was looking up all that, I decided to go for the prefix + suffix(es) route, as that just seemed to be the most unambiguous. Convenience wasn't really a factor here, because there's the "path_with_file_* family" of functions that should handle most of the replacement cases. (Besides, I found it quite nice that I could join() on the prefix + suffixes (e.g. join(".", "foo", "tar", "gz")) that I first extracted with path_file_prefix() and path_file_suffixes(); I like that there's an "inverse" operation.) *But,* I wouldn't be opposed to adding a function that just returns "tar.gz" for the above case. Perhaps with a different name though :P [1] https://doc.rust-lang.org/std/path/struct.Path.html#method.extension [2] https://en.cppreference.com/w/cpp/filesystem/path/extension [3] https://github.com/JetBrains/kotlin/blob/rrr/2.1.0/core-docs/libraries/stdlib/jdk7/src/kotlin/io/path/PathUtils.kt#L46 [4] https://docs.python.org/3/library/pathlib.html#pathlib.PurePath.suffix [5] https://github.com/rust-lang/rust/issues/86319 > > > + > > + croak "\$path is undef" if !defined($path); > > + croak "one of the provided suffixes is undef" > > + if any { !defined($_) } @suffixes; > > + croak "one of the provided suffixes contains a path separator" > > + if any { $_ =~ m|/| } @suffixes; > > + croak "one of the provided suffixes contains a dot" > > + if any { $_ =~ m|\.| } @suffixes; > > + > > + return undef if !defined(path_file_name($path)); > > + > > + my $parent = path_parent($path); > > + > > + # sanity check -- should not happen because we checked for file name, > > + # and the existence of a file name implies there's a parent > > + confess "parent of \$path is undef" if !defined($parent); > > + > > + # Don't modify $path if there are no suffixes to be removed > > + my @existing_suffixes = path_file_suffixes($path); > > + return $path if !scalar(@suffixes) && !scalar(@existing_suffixes); > > + > > + my $prefix = path_file_prefix($path); > > + > > + # sanity check > > + confess "\$prefix is undef" if !defined($prefix); > > + > > + my $file_name = join(".", $prefix, @suffixes); > > + > > + # 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") > > + # (Done also in path_with_file_name) > > + if ($parent eq '.' && $path !~ m|/|) { > > + return $file_name; > > + } > > + > > + return path_push($parent, $file_name); > > +} > > + > > +=head3 path_file_suffix($path) > > + > > +Returns the suffix of the C<$path>'s file name. If the C<$path> does not have a > > +valid file name or if the file name has no suffix, C is returned > > +instead. > > + > > +The suffix of a file name is essentially its extension, e.g. > > +C has the suffix C. If there are multiple suffixes, > > +only the last will be returned; e.g. C has the suffix C. > > + > > +B Files like e.g. C have an empty string as suffix. > > + > > +For getting all suffixes of a path, see C>>. > > + > > +Throws an exception if C<$path> is C. > > + > > +=cut > > + > > +sub path_file_suffix : prototype($) { > > + my ($path) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + > > + my $file_name = path_file_name($path); > > + return undef if !defined($file_name); > > + > > + (undef, $file_name) = _path_file_prefix($file_name); > > + > > + my @suffixes = _path_file_suffixes($file_name); > > + > > + return pop(@suffixes); > > +} > > + > > +=head3 path_with_file_suffix($path, $suffix) > > + > > +Returns C<$path> with a new C<$suffix>. This is similar to > > +C>>, > > +except that only the last suffix of the file name is replaced. > > + > > +If the C<$path> does not have a file name, C 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, 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, or if C<$suffix> > > +contains a path separator (C) or a C<.>. > > + > > +=cut > > + > > +sub path_with_file_suffix : prototype($$) { > > + my ($path, $suffix) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + > > + if (defined($suffix)) { > > + croak "\$suffix contains a path separator" if $suffix =~ m|/|; > > + croak "\$suffix contains a dot" if $suffix =~ m|\.|; > > + } > > + > > + return undef if !defined(path_file_name($path)); > > + > > + my $parent = path_parent($path); > > + > > + # sanity check -- should not happen because we checked for file name, > > + # and the existence of a file name implies there's a parent > > + confess "parent of \$path is undef" if !defined($parent); > > + > > + my @suffixes = path_file_suffixes($path); > > + > > + # Don't modify $path if there is no suffix to be removed > > + return $path if !scalar(@suffixes) && !defined($suffix); > > + > > + pop(@suffixes); > > + push(@suffixes, $suffix) if defined($suffix); > > + > > + my $prefix = path_file_prefix($path); > > + > > + # sanity check > > + confess "\$prefix is undef" if !defined($prefix); > > + > > + my $file_name = join(".", $prefix, @suffixes); > > + > > + # 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") > > + # (Done also in path_with_file_name) > > + if ($parent eq '.' && $path !~ m|/|) { > > + return $file_name; > > + } > > + > > + return path_push($parent, $file_name); > > +} > > + > > +=head3 path_file_parts($path) > > + > > +Returns the parts that constitute the file name (prefix and suffixes) of a > > +C<$path> as a list. If the C<$path> does not have a valid file name, an empty > > +list is returned instead. > > + > > +In scalar context, returns a reference to a list. > > + > > +These parts are split in such a way that allows them to be Ced 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. > > + > > +=cut > > + > > +sub path_file_parts : prototype($) { > > + my ($path) = @_; > > + > > + croak "\$path is undef" if !defined($path); > > + > > + my $file_name = path_file_name($path); > > + if (!defined($file_name)) { > > + return wantarray ? () : []; > > + } > > + > > + my $prefix; > > + ($prefix, $file_name) = _path_file_prefix($file_name); > > + > > + my @suffixes = _path_file_suffixes($file_name); > > + > > + my @file_parts = ($prefix, @suffixes); > > + > > + return wantarray ? @file_parts : \@file_parts; > > +} > > + > > +=head3 path_starts_with($path, $other_path) > > + > > +Checks whether a C<$path> starts with the components of C<$other_path>. > > + > > + my $starts_with = path_starts_with("/etc/pve/firewall/cluster.fw", "/etc/pve"); > > + # 1 > > + > > +Throws an exception if any of the arguments is C. > > + > > +=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. > > + > > +=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