URI-PackageURL/lib/URI/VersionRange.pm
package URI::VersionRange;
use feature ':5.10';
use strict;
use utf8;
use warnings;
use Carp ();
use List::Util qw(first);
use Exporter qw(import);
use URI::VersionRange::Constraint;
use URI::VersionRange::Version;
use constant DEBUG => $ENV{VERS_DEBUG};
use constant TRUE => !!1;
use constant FALSE => !!0;
use overload '""' => 'to_string', fallback => 1;
our $VERSION = '2.23';
our @EXPORT = qw(encode_vers decode_vers);
my $VERS_REGEXP = qr{^vers:[a-z\\.\\-\\+][a-z0-9\\.\\-\\+]*/.+};
sub new {
my ($class, %params) = @_;
my $scheme = delete $params{scheme} or Carp::croak "Invalid Version Range: 'scheme' is required";
my $constraints = delete $params{constraints} or Carp::croak "Invalid Version Range: 'constraints' is required";
my @constraints = ();
foreach my $constraint (@{$constraints}) {
if (ref($constraint) ne 'URI::VersionRange::Constraint') {
$constraint = URI::VersionRange::Constraint->from_string($constraint);
}
push @constraints, $constraint;
}
$scheme = lc $scheme;
my $self = {scheme => $scheme, constraints => \@constraints, _version_class => _scheme_version_class($scheme)};
return bless $self, $class;
}
sub _load_version_class {
my $version_class = shift;
if ($version_class->can('new') or eval "require $version_class; 1") {
DEBUG and say STDERR "-- Loaded '$version_class' class";
return 1;
}
DEBUG and say STDERR "-- (E) Failed to load '$version_class' class:" if $@;
return 0;
}
sub _scheme_version_class {
my $scheme = shift;
my @CLASSES = (
join('::', 'URI::VersionRange::Version', lc($scheme)), # Schema specific
'URI::VersionRange::Version::generic', # Generic or used-defined class
'URI::VersionRange::Version' # Fallback class
);
foreach my $version_class (@CLASSES) {
if (_load_version_class($version_class)) {
return $version_class;
}
}
Carp::croak 'Unable to find version scheme class';
}
sub scheme { shift->{scheme} }
sub constraints { shift->{constraints} }
sub encode_vers { __PACKAGE__->new(@_)->to_string }
sub decode_vers { __PACKAGE__->from_string(shift) }
sub from_string {
my ($class, $string) = @_;
if ($string !~ /$VERS_REGEXP/) {
Carp::croak 'Malformed Version Range string';
}
if ($string =~ /^vers\:(none|all)\// && $string !~ /^vers\:(none|all)\/\*$/) {
Carp::croak 'Malformed Version Range string';
}
my %params = ();
# - Remove all spaces and tabs.
# - Start from left, and split once on colon ":".
# - The left hand side is the URI-scheme that must be lowercase.
# Tools must validate that the URI-scheme value is vers.
# - The right hand side is the specifier.
$string =~ s/(\s|\t)+//g;
my @s1 = split(':', $string);
# $params{uri_scheme} = lc $s1[0];
# - Split the specifier from left once on a slash "/".
# - The left hand side is the <versioning-scheme> that must be lowercase. Tools
# should validate that the <versioning-scheme> is a known scheme.
# - The right hand side is a list of one or more constraints. Tools must validate
# that this constraints string is not empty ignoring spaces.
my @s2 = split('/', $s1[1]);
$params{scheme} = lc $s2[0];
# - If the constraints string is equal to "", the ``<version-constraint>``
# is "". Parsing is done and no further processing is needed for this vers.
# A tool should report an error if there are extra characters beyond "*".
# - Strip leading and trailing pipes "|" from the constraints string.
# - Split the constraints on pipe "|". The result is a list of <version-constraint>.
# Consecutive pipes must be treated as one and leading and trailing pipes ignored.
$s2[1] =~ s/(^\|)|(\|$)//g;
my @s3 = split(/\|/, $s2[1]);
$params{constraints} = [];
# - For each <version-constraint>:
# - Determine if the <version-constraint> starts with one of the two comparators:
# - If it starts with ">=", then the comparator is ">=".
# - If it starts with "<=", then the comparator is "<=".
# - If it starts with "!=", then the comparator is "!=".
# - If it starts with "<", then the comparator is "<".
# - If it starts with ">", then the comparator is ">".
# - Remove the comparator from <version-constraint> string start. The remaining string is the version.
# - Otherwise the version is the full <version-constraint> string (which implies an equality comparator of "=")
# - Tools should validate and report an error if the version is empty.
# - If the version contains a percent "%" character, apply URL quoting rules to unquote this string.
# - Append the parsed (comparator, version) to the constraints list.
foreach (@s3) {
push @{$params{constraints}}, URI::VersionRange::Constraint->from_string($_);
}
if (DEBUG) {
say STDERR "-- S1: @s1";
say STDERR "-- S2: @s2";
say STDERR "-- S3: @s3";
}
return $class->new(%params);
}
sub to_string {
return join '', 'vers:', $_[0]->scheme, '/', join('|', @{$_[0]->constraints});
}
sub constraint_contains {
my ($self, $constraint, $version) = @_;
return TRUE if $constraint->comparator eq '*';
my $version_class = $self->{_version_class};
my $v1 = $version_class->parse($version);
my $v2 = $version_class->parse($constraint->version);
return ($v1 == $v2) if ($constraint->comparator eq '=');
return ($v1 != $v2) if ($constraint->comparator eq '!=');
return ($v1 <= $v2) if ($constraint->comparator eq '<=');
return ($v1 >= $v2) if ($constraint->comparator eq '>=');
return ($v1 < $v2) if ($constraint->comparator eq '<');
return ($v1 > $v2) if ($constraint->comparator eq '>');
return FALSE;
}
sub contains {
my ($self, $version) = @_;
my @first = ();
my @second = ();
my $version_class = $self->{_version_class};
if (scalar @{$self->constraints} == 1) {
return $self->constraint_contains($self->constraints->[0], $version);
}
foreach my $constraint (@{$self->constraints}) {
# If the "tested version" is equal to the any of the constraint version
# where the constraint comparator is for equality (any of "=", "<=", or ">=")
# then the "tested version" is in the range. Check is finished.
return TRUE
if ((first { $constraint->comparator eq $_ } ('=', '<=', '>='))
&& ($version_class->parse($version) == $version_class->parse($constraint->version)));
# If the "tested version" is equal to the any of the constraint version
# where the constraint comparator is "=!" then the "tested version" is NOT
# in the range. Check is finished.
return FALSE
if ($constraint->comparator eq '!='
&& ($version_class->parse($version) == $version_class->parse($constraint->version)));
# Split the constraint list in two sub lists:
# a first list where the comparator is "=" or "!="
# a second list where the comparator is neither "=" nor "!="
push @first, $constraint if ((first { $constraint->comparator eq $_ } ('=', '!=')));
push @second, $constraint if (!(first { $constraint->comparator eq $_ } ('=', '!=')));
}
return FALSE unless @second;
if (scalar @second == 1) {
return $self->constraint_contains($second[0], $version);
}
# Iterate over the current and next contiguous constraints pairs (aka. pairwise)
# in the second list.
# For each current and next constraint:
my $is_first_iteration = TRUE;
my $current_constraint = undef;
my $next_constraint = undef;
foreach (_pairwise(@second)) {
($current_constraint, $next_constraint) = @{$_};
DEBUG and say STDERR sprintf '-- Current constraint --> %s', $current_constraint;
DEBUG and say STDERR sprintf '-- Next constraint --> %s', $next_constraint;
# If this is the first iteration and current comparator is "<" or <=" and
# the "tested version" is less than the current version then the "tested
# version" is IN the range. Check is finished.
if ($is_first_iteration) {
return TRUE
if ((first { $current_constraint->comparator eq $_ } ('<=', '<'))
&& ($version_class->parse($version) < $version_class->parse($current_constraint->version)));
$is_first_iteration = FALSE;
}
# If current comparator is ">" or >=" and next comparator is "<" or <="
# and the "tested version" is greater than the current version and the
# "tested version" is less than the next version then the "tested version"
# is IN the range. Check is finished.
if ( (first { $current_constraint->comparator eq $_ } ('>', '>='))
&& (first { $next_constraint->comparator eq $_ } ('<', '<='))
&& ($version_class->parse($version) > $version_class->parse($current_constraint->version))
&& ($version_class->parse($version) < $version_class->parse($next_constraint->version)))
{
return TRUE;
}
# If current comparator is "<" or <=" and next comparator is ">" or >="
# then these versions are out the range. Continue to the next iteration.
elsif ((first { $current_constraint->comparator eq $_ } ('<', '<='))
&& (first { $next_constraint->comparator } ('>', '>=')))
{
next;
}
}
# If this is the last iteration and next comparator is ">" or >=" and the
# "tested version" is greater than the next version then the "tested version"
# is IN the range. Check is finished.
return TRUE
if ((first { $next_constraint->comparator eq $_ } ('>', '>='))
&& ($version_class->parse($version) > $version_class->parse($next_constraint->version)));
return FALSE;
}
sub TO_JSON {
return {scheme => $_[0]->scheme, constraints => $_[0]->constraints};
}
sub _pairwise {
my @out = ();
for (my $i = 0; $i < scalar @_; $i++) {
push @out, [$_[$i], $_[$i + 1]] if $_[$i + 1];
}
return @out;
}
1;
__END__
=head1 NAME
URI::VersionRange - Perl extension for Version Range Specification
=head1 SYNOPSIS
use URI::VersionRange;
# OO-interface
$vers = URI::VersionRange->new(
scheme => 'cpan',
constraints => ['>2.00']
);
say $vers; # vers:cpan/>2.00
if ($vers->contains('2.10')) {
say "The version is in range";
}
# Parse "vers" string
$vers = URI::VersionRange->from_string('vers:cpan/>2.00|<2.23');
# exported functions
$vers = decode_vers('vers:cpan/>2.00|<2.23');
say $vers->scheme; # cpan
$vers_string = encode_vers(scheme => cpan, constraints => ['>2.00']);
say $vers_string; # vers:cpan/>2.00
=head1 DESCRIPTION
A version range specifier (aka. "vers") is a URI string using the C<vers> URI-scheme with this syntax:
vers:<versioning-scheme>/<version-constraint>|<version-constraint>|...
C<vers> is the URI-scheme and is an acronym for "VErsion Range Specifier".
The pipe "|" is used as a simple separator between C<version-constraint>.
Each C<version-constraint> in this pipe-separated list contains a comparator and a version:
<comparator:version>
This list of C<version-constraint> are signposts in the version timeline of a package
that specify version intervals.
A C<version> satisfies a version range specifier if it is contained within any
of the intervals defined by these C<version-constraint>.
L<https://github.com/package-url/purl-spec>
=head2 FUNCTIONAL INTERFACE
They are exported by default:
=over
=item $vers_string = encode_vers(%params);
Converts the given C<vers> components to "vers" string. Croaks on error.
This function call is functionally identical to:
$vers_string = URI::VersionRange->new(%params)->to_string;
=item $vers = decode_vers($vers_string);
Converts the given "vers" string to L<URI::VersionRange> object. Croaks on error.
This function call is functionally identical to:
$vers = URI::VersionRange->from_string($vers_string);
=back
=head2 OBJECT-ORIENTED INTERFACE
=over
=item $vers = URI::VersionRange->new( scheme => STRING, constraints => ARRAY )
Create new B<URI::VersionRange> instance using provided C<vers> components
(scheme, constraints).
=item $vers->scheme
By convention the versioning scheme should be the same as the L<URI::PackageURL>
package C<type> for a given package ecosystem.
=item $vers->constraints
C<constraints> is ARRAY of L<URI::VersionRange::Constraint> object.
=item $vers->contains($version)
Check if a version is contained within a range
my $vers = URI::VersionRange::from_string('vers:cpan/>2.00|<2.23');
if ($vers->contains('2.10')) {
say "The version is in range";
}
See L<URI::VersionRange::Version>.
=item $vers->constraint_contains
Check if a version is contained within a specific constraint.
See L<URI::VersionRange::Version>.
=item $vers->to_string
Stringify C<vers> components.
=item $vers->TO_JSON
Helper method for JSON modules (L<JSON>, L<JSON::PP>, L<JSON::XS>, L<Mojo::JSON>, etc).
use Mojo::JSON qw(encode_json);
say encode_json($vers); # {"constraints":[{"comparator":">","version":"2.00"},{"comparator":"<","version":"2.23"}],"scheme":"cpan"}
=item $vers = URI::VersionRange->from_string($vers_string);
Converts the given "vers" string to L<URI::VersionRange> object. Croaks on error.
=back
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/giterlizzi/perl-URI-PackageURL/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/giterlizzi/perl-URI-PackageURL>
git clone https://github.com/giterlizzi/perl-URI-PackageURL.git
=head1 AUTHOR
=over 4
=item * Giuseppe Di Terlizzi <gdt@cpan.org>
=back
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2022-2025 by Giuseppe Di Terlizzi.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut