—

              
package App::PerlReleaseUtils;
use 5.010001;
use strict;
use warnings;
use Log::ger;
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-06-12'; # DATE
our $DIST = 'App-PerlReleaseUtils'; # DIST
our $VERSION = '0.002'; # VERSION
our %SPEC;
#our %argspec0_release = (
#    dist => {
#        schema => 'perl::relname*',
#        req => 1,
#        pos => 0,
#        completion => sub {
#            require Complete::Dist;
#            my %args = @_;
#            Complete::Dist::complete_dist(word=>$args{word});
#        },
#    },
#);
$SPEC{grep_perl_release} = {
    v => 1.1,
    summary => 'Grep Perl module release tarball name from text',
    description => <<'_',
The utility displays lines from input which resemble Perl module release tarball
name (e.g. Bar-Qux-2.34.tar.gz, but not Bar-Qux-2.34 or Bar-Qux or Bar::Qux).
    % echo -e "First line\nSecond line has Foo-Bar\nThird line has Foo-Bar-1.23\nBaz-Qux-2.34.tar.gz" | grep-perl-release
    Baz-Qux-2.34.tar.gz
_
    args => {
        include_latest_versions => {
            summary => "Only include latest N version(s) of each dist",
            schema => 'posint*',
        },
        exclude_latest_versions => {
            summary => "Exclude latest N version(s) of each dist",
            schema => 'posint*',
        },
        include_dev_release => {
            schema => 'bool*',
            default => 1,
        },
        include_nondev_release => {
            schema => 'bool*',
            default => 1,
        },
    },
    args_rels => {
        choose_one => [qw/include_latest_versions exclude_latest_versions/],
    },
};
sub grep_perl_release {
    require Regexp::Pattern::Perl::Release;
    # XXX schema
    my %args = @_;
    $args{include_dev_release} //= 1;
    $args{include_nondev_release} //= 1;
    my $re = qr/\A(?:$Regexp::Pattern::Perl::Release::RE{perl_release_archive_filename}{pat})\z/;
    my @rels;
    my %dists;
    while (defined(my $line = <>)) {
        chomp $line;
        unless ($line =~ $re) {
            log_trace "Line excluded (not a perl release archive filename): $line";
            next;
        }
        my $rec = {
            release => $line,
            dist => $1,
            version0 => $2,
        };
        ($rec->{version} = $rec->{version0}) =~ s/-TRIAL/_001/;
        #log_trace "D:version=<%s>", $rec->{version};
        eval { $rec->{version_parsed} = version->parse($rec->{version}) };
        if ($@) {
            log_warn "Release %s: Can't parse version %s: %s, skipping this release", $line, $rec->{version}, $@;
            next;
        }
        $rec->{is_dev} = $rec->{version} =~ /_/ ? 1:0;
        if ($rec->{is_dev} && !$args{include_dev_release}) {
            log_trace "Line excluded (excluding dev perl release): $line";
            next;
        }
        if (!$rec->{is_dev} && !$args{include_nondev_release}) {
            log_trace "Line excluded (excluding non-dev perl release): $line";
            next;
        }
        $dists{ $rec->{dist} } //= [];
        push @rels, $rec;
        push @{ $dists{ $rec->{dist} } }, $rec;
    }
    if (defined($args{include_latest_versions}) || defined($args{exclude_latest_versions})) {
        my @res;
      DIST:
        for my $dist (keys %dists) {
          FILTER: {
                if (defined $args{include_latest_versions}) {
                    if (@{ $dists{$dist} } <= $args{include_latest_versions}) {
                        last FILTER;
                    }
                } elsif (defined $args{exclude_latest_versions}) {
                    if (@{ $dists{$dist} } <= $args{exclude_latest_versions}) {
                        last FILTER;
                    }
                }
                # sort each dist by version
                $dists{$dist} = [ sort {$a->{version_parsed} <=> $b->{version_parsed}} @{ $dists{$dist} } ];
                # only keep n latest versions
                if (defined $args{include_latest_versions}) {
                    my @removed = splice @{ $dists{$dist} }, 0, @{ $dists{$dist} } - $args{include_latest_versions};
                    log_trace "Excluding old releases of dist %s: %s", $dist, [map {$_->{release}} @removed];
                    # exclude n latest versions
                } elsif (defined $args{exclude_latest_versions}) {
                    my @removed = splice @{ $dists{$dist} }, @{ $dists{$dist} } - $args{exclude_latest_versions};
                    log_trace "Excluding latest releases of dist %s: %s", $dist, [map {$_->{release}} @removed];
                }
            } # FILTER
            push @res, map { $_->{release} } @{ $dists{$dist} };
        }
        return [200, "OK", \@res];
    } else {
        return [200, "OK", [map { $_->{release} } @rels]];
    }
}
1;
# ABSTRACT: Collection of utilities related to Perl distribution releases
__END__
HideShow 146 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
App::PerlReleaseUtils - Collection of utilities related to Perl distribution releases
=head1 VERSION
This document describes version 0.002 of App::PerlReleaseUtils (from Perl distribution App-PerlReleaseUtils), released on 2022-06-12.
=head1 SYNOPSIS
This distribution provides the following command-line utilities related to Perl
distribution releases:
=over
=item * L<grep-perl-release>
=back
=head1 FUNCTIONS
=head2 grep_perl_release
Usage:
 grep_perl_release(%args) -> [$status_code, $reason, $payload, \%result_meta]
This function is not exported.
Arguments ('*' denotes required arguments):
=over 4
=item * B<exclude_latest_versions> => I<posint>
Exclude latest N version(s) of each dist.
=item * B<include_dev_release> => I<bool> (default: 1)
=item * B<include_latest_versions> => I<posint>
Only include latest N version(s) of each dist.
=item * B<include_nondev_release> => I<bool> (default: 1)
=back
Returns an enveloped result (an array).
First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value:  (any)
=head1 FAQ
=head2 What is the purpose of this distribution? Haven't other similar utilities existed?
For example, L<mpath> from L<Module::Path> distribution is similar to L<pmpath>
in L<App::PMUtils>, and L<mversion> from L<Module::Version> distribution is
similar to L<pmversion> from L<App::PMUtils> distribution, and so on.
True. The main point of these utilities is shell tab completion, to save
typing.
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-PerlReleaseUtils>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-PerlReleaseUtils>.
=head1 SEE ALSO
Below is the list of distributions that provide CLI utilities for various
purposes, with the focus on providing shell tab completion feature.
L<App::DistUtils>, utilities related to Perl distributions.
L<App::DzilUtils>, utilities related to L<Dist::Zilla>.
L<App::GitUtils>, utilities related to git.
L<App::IODUtils>, utilities related to L<IOD> configuration files.
L<App::LedgerUtils>, utilities related to Ledger CLI files.
L<App::PerlReleaseUtils>, utilities related to Perl distribution releases.
L<App::PlUtils>, utilities related to Perl scripts.
L<App::PMUtils>, utilities related to Perl modules.
L<App::ProgUtils>, utilities related to programs.
L<App::WeaverUtils>, utilities related to L<Pod::Weaver>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
 % prove -l
If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
beyond that are considered a bug and can be reported to me.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2022 by perlancar <perlancar@cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-PerlReleaseUtils>
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=cut