1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
|
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.22';
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-2024, Giuseppe Di Terlizzi <gdt\@cpan.org>
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 <https://metacpan.org/dist/URI-PackageURL>.
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__
=encoding utf-8
=head1 NAME
URI::VersionRange::App - URL::VersionRange (vers) Command Line Interface
=head1 SYNOPSIS
use URI::VersionRange::App qw(run);
run(\@ARGV);
=head1 DESCRIPTION
URI::VersionRange::App "Command Line Interface" helper module for C<vers-tool(1)>.
=over
=item URI::VersionRange->run(@args)
Execute the command
=item cli_error($error)
Clean error
=back
=head1 AUTHOR
L<Giuseppe Di Terlizzi|https://metacpan.org/author/gdt>
=head1 COPYRIGHT AND LICENSE
Copyright © 2022-2024 L<Giuseppe Di Terlizzi|https://metacpan.org/author/gdt>
You may use and distribute this module according to the same terms
that Perl is distributed under.
=cut
|