File Coverage

blib/lib/URI/VersionRange/App.pm

Criterion	Covered	Total	%
statement	47	71	66.2
branch	10	28	35.7
condition			n/a
subroutine	11	12	91.6
pod	2	2	100.0
total	70	113	61.9

package URI::VersionRange::App;

use feature ':5.10';
use strict;
use warnings;
use utf8;

use Getopt::Long qw(GetOptionsFromArray :config gnu_compat);
use Pod::Usage   qw(pod2usage);
use Carp         ();
use JSON::PP     ();
use Data::Dumper ();

use URI::VersionRange ();

our $VERSION = '2.25';

sub cli_error {
    my ($error) = @_;
    $error =~ s/ at .* line \d+.*//;
    print STDERR "ERROR: $error\n";
}

sub run {

    my ($class, @args) = @_;

    my %options = (format => 'json');

    GetOptionsFromArray(
        \@args, \%options, qw(
            help
            man
            v

            contains=s

            null|0
            format=s

            json
            human-readable|h
        )
    ) or pod2usage(-verbose => 0);

    pod2usage(-exitstatus => 0, -verbose => 2) if defined $options{man};
    pod2usage(-exitstatus => 0, -verbose => 0) if defined $options{help};

    if (defined $options{v}) {

        (my $progname = $0) =~ s/.*\///;

        say <<"VERSION";
$progname version $URI::VersionRange::VERSION

Copyright 2022-2026, Giuseppe Di Terlizzi

This program is part of the "URI-PackageURL" distribution and is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.

Complete documentation for $progname can be found using 'man $progname'
or on the internet at .
VERSION

        return 0;

    }

    my ($vers_string) = @args;

    pod2usage(-verbose => 1) if !$vers_string;

    $options{format} = 'json'           if defined $options{json};
    $options{format} = 'human-readable' if defined $options{'human-readable'};

    my $vers = eval { URI::VersionRange->from_string($vers_string) };

    if ($@) {
        cli_error($@);
        return 1;
    }

    if (defined $options{contains}) {

        my $vers_comparator_class = join '::', 'URI::VersionRange::Version', $vers->scheme;

        if (!$vers_comparator_class->can('new')) {
            say STDERR 'WARNING: Loaded the fallback scheme class comparator.';
            say STDERR '         The comparison may not work correctly!';
        }

        my $res = eval { $vers->contains($options{contains}) };

        if ($@) {
            cli_error($@);
            return 1;
        }

        say STDERR $res ? 'true' : 'false';
        return !$res;

    }

    if ($options{format} eq 'json') {
        print JSON::PP->new->canonical->pretty(1)->convert_blessed(1)->encode($vers);
        return 0;
    }

    if ($options{format} eq 'human-readable') {
        say $vers->scheme;
        say "- " . $_->to_human_string for (@{$vers->constraints});
        return 0;
    }

}

1;

__END__