view release on metacpan or  search on metacpan

lib/App/DocKnot/Util.pm  view on Meta::CPAN

# Shared utility functions for other DocKnot modules.
#
# A collection of random utility functions that are used by more than one
# DocKnot module but don't make sense as App::DocKnot methods.
#
# SPDX-License-Identifier: MIT

##############################################################################
# Modules and declarations
##############################################################################

package App::DocKnot::Util v8.0.1;

use 5.024;
use autodie;
use warnings FATAL => 'utf8';

use Carp qw(croak);
use Exporter qw(import);
use List::SomeUtils qw(all);
use Path::Tiny qw(path);
use Sort::Versions qw(versioncmp);

our @EXPORT_OK = qw(is_newer latest_tarball print_checked print_fh);

##############################################################################
# Public interface
##############################################################################

# Check if a file, which may not exist, is newer than another list of files.
#
# $file   - File whose timestamp to compare
# @others - Other files to compare against
#
# Returns: True if $file exists and is newer than @others, false otherwise
sub is_newer {
    my ($file, @others) = @_;
    return if !$file->exists();
    my $file_mtime = $file->stat()->[9];
    my @others_mtimes = map { $_->stat()->[9] } @others;
    return all { $file_mtime >= $_ } @others_mtimes;
}

# Find the files for a given package with the latest version and return them
# along with some associated metadata.
#
# $path    - Path::Tiny path to directory
# $tarname - Name of the tarball before the version component
#
# Returns: Anonymous hash with the following keys:
#            version - Latest version found
#            files   - Array of files for that version
#          or undef if no matching files were found
#  Throws: Text exception on any error
sub latest_tarball {
    my ($path, $tarname) = @_;

    # Collect the list of matching files and extract their version numbers.
    return if !$path->is_dir();
    my $regex = qr{ \A \Q$tarname\E - (v?[\d.]+) [.] }xms;
    my @files = map { $_->basename() } $path->children($regex);
    my @versions = map { m{ $regex }xms ? [$1, $_] : () } @files;
    return if !@versions;

    # Find the latest version and filter the list of files down to only that
    # version.  This will sort versions starting with v later than any version
    # that doesn't start with v.  This is fine for my purposes right now,
    # since the conversion of Perl modules to semantic versions starting with
    # v is one-way, but is not generally correct.
    @versions = reverse(sort { versioncmp($a->[0], $b->[0]) } @versions);
    my $latest = $versions[0][0];
    @files = map { $_->[1] } grep { $_->[0] eq $latest } @versions;

    # Return the results.
    return {
        version => $latest,
        files   => \@files,
    };
}

# print with error checking.  autodie unfortunately can't help us because
# print can't be prototyped and hence can't be overridden.
#
# @args - Arguments to print to stdout
#
# Returns: undef
#  Throws: Text exception on output failure
sub print_checked {
    my (@args) = @_;
    print @args or croak('print failed');
    return;
}

# print with error checking and an explicit file handle.  autodie
# unfortunately can't help us because print can't be prototyped and
# hence can't be overridden.
#
# $fh   - Output file handle
# $file - File name for error reporting
# @args - Remaining arguments to print