1use v5.10; 2use strict; 3use warnings; 4package CPAN::Meta::Requirements::Range; 5# ABSTRACT: a set of version requirements for a CPAN dist 6 7our $VERSION = '2.143'; 8 9use Carp (); 10 11#pod =head1 SYNOPSIS 12#pod 13#pod use CPAN::Meta::Requirements::Range; 14#pod 15#pod my $range = CPAN::Meta::Requirements::Range->with_minimum(1); 16#pod 17#pod $range = $range->with_maximum('v2.2'); 18#pod 19#pod my $stringified = $range->as_string; 20#pod 21#pod =head1 DESCRIPTION 22#pod 23#pod A CPAN::Meta::Requirements::Range object models a set of version constraints like 24#pod those specified in the F<META.yml> or F<META.json> files in CPAN distributions, 25#pod and as defined by L<CPAN::Meta::Spec>; 26#pod It can be built up by adding more and more constraints, and it will reduce them 27#pod to the simplest representation. 28#pod 29#pod Logically impossible constraints will be identified immediately by thrown 30#pod exceptions. 31#pod 32#pod =cut 33 34use Carp (); 35 36package 37 CPAN::Meta::Requirements::Range::_Base; 38 39# To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls 40# before 5.10, we fall back to the EUMM bundled compatibility version module if 41# that's the only thing available. This shouldn't ever happen in a normal CPAN 42# install of CPAN::Meta::Requirements, as version.pm will be picked up from 43# prereqs and be available at runtime. 44 45BEGIN { 46 eval "use version ()"; ## no critic 47 if ( my $err = $@ ) { 48 eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic 49 } 50} 51 52# from version::vpp 53sub _find_magic_vstring { 54 my $value = shift; 55 my $tvalue = ''; 56 require B; 57 my $sv = B::svref_2object(\$value); 58 my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; 59 while ( $magic ) { 60 if ( $magic->TYPE eq 'V' ) { 61 $tvalue = $magic->PTR; 62 $tvalue =~ s/^v?(.+)$/v$1/; 63 last; 64 } 65 else { 66 $magic = $magic->MOREMAGIC; 67 } 68 } 69 return $tvalue; 70} 71 72# Perl 5.10.0 didn't have "is_qv" in version.pm 73*_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; 74 75# construct once, reuse many times 76my $V0 = version->new(0); 77 78# safe if given an unblessed reference 79sub _isa_version { 80 UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version') 81} 82 83sub _version_object { 84 my ($self, $version, $module, $bad_version_hook) = @_; 85 86 my ($vobj, $err); 87 88 if (not defined $version or (!ref($version) && $version eq '0')) { 89 return $V0; 90 } 91 elsif ( ref($version) eq 'version' || ( ref($version) && _isa_version($version) ) ) { 92 $vobj = $version; 93 } 94 else { 95 # hack around version::vpp not handling <3 character vstring literals 96 if ( $INC{'version/vpp.pm'} || $INC{'ExtUtils/MakeMaker/version/vpp.pm'} ) { 97 my $magic = _find_magic_vstring( $version ); 98 $version = $magic if length $magic; 99 } 100 # pad to 3 characters if before 5.8.1 and appears to be a v-string 101 if ( $] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1) ne 'v' && length($version) < 3 ) { 102 $version .= "\0" x (3 - length($version)); 103 } 104 eval { 105 local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" }; 106 # avoid specific segfault on some older version.pm versions 107 die "Invalid version: $version" if $version eq 'version'; 108 $vobj = version->new($version); 109 }; 110 if ( my $err = $@ ) { 111 $vobj = eval { $bad_version_hook->($version, $module) } 112 if ref $bad_version_hook eq 'CODE'; 113 unless (eval { $vobj->isa("version") }) { 114 $err =~ s{ at .* line \d+.*$}{}; 115 die "Can't convert '$version': $err"; 116 } 117 } 118 } 119 120 # ensure no leading '.' 121 if ( $vobj =~ m{\A\.} ) { 122 $vobj = version->new("0$vobj"); 123 } 124 125 # ensure normal v-string form 126 if ( _is_qv($vobj) ) { 127 $vobj = version->new($vobj->normal); 128 } 129 130 return $vobj; 131} 132 133#pod =method with_string_requirement 134#pod 135#pod $req->with_string_requirement('>= 1.208, <= 2.206'); 136#pod $req->with_string_requirement(v1.208); 137#pod 138#pod This method parses the passed in string and adds the appropriate requirement. 139#pod A version can be a Perl "v-string". It understands version ranges as described 140#pod in the L<CPAN::Meta::Spec/Version Ranges>. For example: 141#pod 142#pod =over 4 143#pod 144#pod =item 1.3 145#pod 146#pod =item >= 1.3 147#pod 148#pod =item <= 1.3 149#pod 150#pod =item == 1.3 151#pod 152#pod =item != 1.3 153#pod 154#pod =item > 1.3 155#pod 156#pod =item < 1.3 157#pod 158#pod =item >= 1.3, != 1.5, <= 2.0 159#pod 160#pod A version number without an operator is equivalent to specifying a minimum 161#pod (C<E<gt>=>). Extra whitespace is allowed. 162#pod 163#pod =back 164#pod 165#pod =cut 166 167my %methods_for_op = ( 168 '==' => [ qw(with_exact_version) ], 169 '!=' => [ qw(with_exclusion) ], 170 '>=' => [ qw(with_minimum) ], 171 '<=' => [ qw(with_maximum) ], 172 '>' => [ qw(with_minimum with_exclusion) ], 173 '<' => [ qw(with_maximum with_exclusion) ], 174); 175 176sub with_string_requirement { 177 my ($self, $req, $module, $bad_version_hook) = @_; 178 $module //= 'module'; 179 180 unless ( defined $req && length $req ) { 181 $req = 0; 182 Carp::carp("Undefined requirement for $module treated as '0'"); 183 } 184 185 my $magic = _find_magic_vstring( $req ); 186 if (length $magic) { 187 return $self->with_minimum($magic, $module, $bad_version_hook); 188 } 189 190 my @parts = split qr{\s*,\s*}, $req; 191 192 for my $part (@parts) { 193 my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z}; 194 195 if (! defined $op) { 196 $self = $self->with_minimum($part, $module, $bad_version_hook); 197 } else { 198 Carp::croak("illegal requirement string: $req") 199 unless my $methods = $methods_for_op{ $op }; 200 201 $self = $self->$_($ver, $module, $bad_version_hook) for @$methods; 202 } 203 } 204 205 return $self; 206} 207 208#pod =method with_range 209#pod 210#pod $range->with_range($other_range) 211#pod 212#pod This creates a new range object that is a merge two others. 213#pod 214#pod =cut 215 216sub with_range { 217 my ($self, $other, $module, $bad_version_hook) = @_; 218 for my $modifier($other->_as_modifiers) { 219 my ($method, $arg) = @$modifier; 220 $self = $self->$method($arg, $module, $bad_version_hook); 221 } 222 return $self; 223} 224 225package CPAN::Meta::Requirements::Range; 226 227our @ISA = 'CPAN::Meta::Requirements::Range::_Base'; 228 229sub _clone { 230 return (bless { } => $_[0]) unless ref $_[0]; 231 232 my ($s) = @_; 233 my %guts = ( 234 (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()), 235 (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()), 236 237 (exists $s->{exclusions} 238 ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ]) 239 : ()), 240 ); 241 242 bless \%guts => ref($s); 243} 244 245#pod =method with_exact_version 246#pod 247#pod $range->with_exact_version( $version ); 248#pod 249#pod This sets the version required to I<exactly> the given 250#pod version. No other version would be considered acceptable. 251#pod 252#pod This method returns the version range object. 253#pod 254#pod =cut 255 256sub with_exact_version { 257 my ($self, $version, $module, $bad_version_hook) = @_; 258 $module //= 'module'; 259 $self = $self->_clone; 260 $version = $self->_version_object($version, $module, $bad_version_hook); 261 262 unless ($self->accepts($version)) { 263 $self->_reject_requirements( 264 $module, 265 "exact specification $version outside of range " . $self->as_string 266 ); 267 } 268 269 return CPAN::Meta::Requirements::Range::_Exact->_new($version); 270} 271 272sub _simplify { 273 my ($self, $module) = @_; 274 275 if (defined $self->{minimum} and defined $self->{maximum}) { 276 if ($self->{minimum} == $self->{maximum}) { 277 if (grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] }) { 278 $self->_reject_requirements( 279 $module, 280 "minimum and maximum are both $self->{minimum}, which is excluded", 281 ); 282 } 283 284 return CPAN::Meta::Requirements::Range::_Exact->_new($self->{minimum}); 285 } 286 287 if ($self->{minimum} > $self->{maximum}) { 288 $self->_reject_requirements( 289 $module, 290 "minimum $self->{minimum} exceeds maximum $self->{maximum}", 291 ); 292 } 293 } 294 295 # eliminate irrelevant exclusions 296 if ($self->{exclusions}) { 297 my %seen; 298 @{ $self->{exclusions} } = grep { 299 (! defined $self->{minimum} or $_ >= $self->{minimum}) 300 and 301 (! defined $self->{maximum} or $_ <= $self->{maximum}) 302 and 303 ! $seen{$_}++ 304 } @{ $self->{exclusions} }; 305 } 306 307 return $self; 308} 309 310#pod =method with_minimum 311#pod 312#pod $range->with_minimum( $version ); 313#pod 314#pod This adds a new minimum version requirement. If the new requirement is 315#pod redundant to the existing specification, this has no effect. 316#pod 317#pod Minimum requirements are inclusive. C<$version> is required, along with any 318#pod greater version number. 319#pod 320#pod This method returns the version range object. 321#pod 322#pod =cut 323 324sub with_minimum { 325 my ($self, $minimum, $module, $bad_version_hook) = @_; 326 $module //= 'module'; 327 $self = $self->_clone; 328 $minimum = $self->_version_object( $minimum, $module, $bad_version_hook ); 329 330 if (defined (my $old_min = $self->{minimum})) { 331 $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0]; 332 } else { 333 $self->{minimum} = $minimum; 334 } 335 336 return $self->_simplify($module); 337} 338 339#pod =method with_maximum 340#pod 341#pod $range->with_maximum( $version ); 342#pod 343#pod This adds a new maximum version requirement. If the new requirement is 344#pod redundant to the existing specification, this has no effect. 345#pod 346#pod Maximum requirements are inclusive. No version strictly greater than the given 347#pod version is allowed. 348#pod 349#pod This method returns the version range object. 350#pod 351#pod =cut 352 353sub with_maximum { 354 my ($self, $maximum, $module, $bad_version_hook) = @_; 355 $module //= 'module'; 356 $self = $self->_clone; 357 $maximum = $self->_version_object( $maximum, $module, $bad_version_hook ); 358 359 if (defined (my $old_max = $self->{maximum})) { 360 $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0]; 361 } else { 362 $self->{maximum} = $maximum; 363 } 364 365 return $self->_simplify($module); 366} 367 368#pod =method with_exclusion 369#pod 370#pod $range->with_exclusion( $version ); 371#pod 372#pod This adds a new excluded version. For example, you might use these three 373#pod method calls: 374#pod 375#pod $range->with_minimum( '1.00' ); 376#pod $range->with_maximum( '1.82' ); 377#pod 378#pod $range->with_exclusion( '1.75' ); 379#pod 380#pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for 381#pod 1.75. 382#pod 383#pod This method returns the requirements object. 384#pod 385#pod =cut 386 387sub with_exclusion { 388 my ($self, $exclusion, $module, $bad_version_hook) = @_; 389 $module //= 'module'; 390 $self = $self->_clone; 391 $exclusion = $self->_version_object( $exclusion, $module, $bad_version_hook ); 392 393 push @{ $self->{exclusions} ||= [] }, $exclusion; 394 395 return $self->_simplify($module); 396} 397 398sub _as_modifiers { 399 my ($self) = @_; 400 my @mods; 401 push @mods, [ with_minimum => $self->{minimum} ] if exists $self->{minimum}; 402 push @mods, [ with_maximum => $self->{maximum} ] if exists $self->{maximum}; 403 push @mods, map {; [ with_exclusion => $_ ] } @{$self->{exclusions} || []}; 404 return @mods; 405} 406 407#pod =method as_struct 408#pod 409#pod $range->as_struct( $module ); 410#pod 411#pod This returns a data structure containing the version requirements. This should 412#pod not be used for version checks (see L</accepts_module> instead). 413#pod 414#pod =cut 415 416sub as_struct { 417 my ($self) = @_; 418 419 return 0 if ! keys %$self; 420 421 my @exclusions = @{ $self->{exclusions} || [] }; 422 423 my @parts; 424 425 for my $tuple ( 426 [ qw( >= > minimum ) ], 427 [ qw( <= < maximum ) ], 428 ) { 429 my ($op, $e_op, $k) = @$tuple; 430 if (exists $self->{$k}) { 431 my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions; 432 if (@new_exclusions == @exclusions) { 433 push @parts, [ $op, "$self->{ $k }" ]; 434 } else { 435 push @parts, [ $e_op, "$self->{ $k }" ]; 436 @exclusions = @new_exclusions; 437 } 438 } 439 } 440 441 push @parts, map {; [ "!=", "$_" ] } @exclusions; 442 443 return \@parts; 444} 445 446#pod =method as_string 447#pod 448#pod $range->as_string; 449#pod 450#pod This returns a string containing the version requirements in the format 451#pod described in L<CPAN::Meta::Spec>. This should only be used for informational 452#pod purposes such as error messages and should not be interpreted or used for 453#pod comparison (see L</accepts> instead). 454#pod 455#pod =cut 456 457sub as_string { 458 my ($self) = @_; 459 460 my @parts = @{ $self->as_struct }; 461 462 return $parts[0][1] if @parts == 1 and $parts[0][0] eq '>='; 463 464 return join q{, }, map {; join q{ }, @$_ } @parts; 465} 466 467sub _reject_requirements { 468 my ($self, $module, $error) = @_; 469 Carp::croak("illegal requirements for $module: $error") 470} 471 472#pod =method accepts 473#pod 474#pod my $bool = $range->accepts($version); 475#pod 476#pod Given a version, this method returns true if the version specification 477#pod accepts the provided version. In other words, given: 478#pod 479#pod '>= 1.00, < 2.00' 480#pod 481#pod We will accept 1.00 and 1.75 but not 0.50 or 2.00. 482#pod 483#pod =cut 484 485sub accepts { 486 my ($self, $version) = @_; 487 488 return if defined $self->{minimum} and $version < $self->{minimum}; 489 return if defined $self->{maximum} and $version > $self->{maximum}; 490 return if defined $self->{exclusions} 491 and grep { $version == $_ } @{ $self->{exclusions} }; 492 493 return 1; 494} 495 496#pod =method is_simple 497#pod 498#pod This method returns true if and only if the range is an inclusive minimum 499#pod -- that is, if their string expression is just the version number. 500#pod 501#pod =cut 502 503sub is_simple { 504 my ($self) = @_; 505 # XXX: This is a complete hack, but also entirely correct. 506 return if $self->as_string =~ /\s/; 507 508 return 1; 509} 510 511package 512 CPAN::Meta::Requirements::Range::_Exact; 513 514our @ISA = 'CPAN::Meta::Requirements::Range::_Base'; 515 516our $VERSION = '2.141'; 517 518BEGIN { 519 eval "use version ()"; ## no critic 520 if ( my $err = $@ ) { 521 eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic 522 } 523} 524 525sub _new { bless { version => $_[1] } => $_[0] } 526 527sub accepts { return $_[0]{version} == $_[1] } 528 529sub _reject_requirements { 530 my ($self, $module, $error) = @_; 531 Carp::croak("illegal requirements for $module: $error") 532} 533 534sub _clone { 535 (ref $_[0])->_new( version->new( $_[0]{version} ) ) 536} 537 538sub with_exact_version { 539 my ($self, $version, $module, $bad_version_hook) = @_; 540 $module //= 'module'; 541 $version = $self->_version_object($version, $module, $bad_version_hook); 542 543 return $self->_clone if $self->accepts($version); 544 545 $self->_reject_requirements( 546 $module, 547 "can't be exactly $version when exact requirement is already $self->{version}", 548 ); 549} 550 551sub with_minimum { 552 my ($self, $minimum, $module, $bad_version_hook) = @_; 553 $module //= 'module'; 554 $minimum = $self->_version_object( $minimum, $module, $bad_version_hook ); 555 556 return $self->_clone if $self->{version} >= $minimum; 557 $self->_reject_requirements( 558 $module, 559 "minimum $minimum exceeds exact specification $self->{version}", 560 ); 561} 562 563sub with_maximum { 564 my ($self, $maximum, $module, $bad_version_hook) = @_; 565 $module //= 'module'; 566 $maximum = $self->_version_object( $maximum, $module, $bad_version_hook ); 567 568 return $self->_clone if $self->{version} <= $maximum; 569 $self->_reject_requirements( 570 $module, 571 "maximum $maximum below exact specification $self->{version}", 572 ); 573} 574 575sub with_exclusion { 576 my ($self, $exclusion, $module, $bad_version_hook) = @_; 577 $module //= 'module'; 578 $exclusion = $self->_version_object( $exclusion, $module, $bad_version_hook ); 579 580 return $self->_clone unless $exclusion == $self->{version}; 581 $self->_reject_requirements( 582 $module, 583 "tried to exclude $exclusion, which is already exactly specified", 584 ); 585} 586 587sub as_string { return "== $_[0]{version}" } 588 589sub as_struct { return [ [ '==', "$_[0]{version}" ] ] } 590 591sub _as_modifiers { return [ with_exact_version => $_[0]{version} ] } 592 593 5941; 595 596# vim: ts=2 sts=2 sw=2 et: 597 598__END__ 599 600=pod 601 602=encoding UTF-8 603 604=head1 NAME 605 606CPAN::Meta::Requirements::Range - a set of version requirements for a CPAN dist 607 608=head1 VERSION 609 610version 2.143 611 612=head1 SYNOPSIS 613 614 use CPAN::Meta::Requirements::Range; 615 616 my $range = CPAN::Meta::Requirements::Range->with_minimum(1); 617 618 $range = $range->with_maximum('v2.2'); 619 620 my $stringified = $range->as_string; 621 622=head1 DESCRIPTION 623 624A CPAN::Meta::Requirements::Range object models a set of version constraints like 625those specified in the F<META.yml> or F<META.json> files in CPAN distributions, 626and as defined by L<CPAN::Meta::Spec>; 627It can be built up by adding more and more constraints, and it will reduce them 628to the simplest representation. 629 630Logically impossible constraints will be identified immediately by thrown 631exceptions. 632 633=head1 METHODS 634 635=head2 with_string_requirement 636 637 $req->with_string_requirement('>= 1.208, <= 2.206'); 638 $req->with_string_requirement(v1.208); 639 640This method parses the passed in string and adds the appropriate requirement. 641A version can be a Perl "v-string". It understands version ranges as described 642in the L<CPAN::Meta::Spec/Version Ranges>. For example: 643 644=over 4 645 646=item 1.3 647 648=item >= 1.3 649 650=item <= 1.3 651 652=item == 1.3 653 654=item != 1.3 655 656=item > 1.3 657 658=item < 1.3 659 660=item >= 1.3, != 1.5, <= 2.0 661 662A version number without an operator is equivalent to specifying a minimum 663(C<E<gt>=>). Extra whitespace is allowed. 664 665=back 666 667=head2 with_range 668 669 $range->with_range($other_range) 670 671This creates a new range object that is a merge two others. 672 673=head2 with_exact_version 674 675 $range->with_exact_version( $version ); 676 677This sets the version required to I<exactly> the given 678version. No other version would be considered acceptable. 679 680This method returns the version range object. 681 682=head2 with_minimum 683 684 $range->with_minimum( $version ); 685 686This adds a new minimum version requirement. If the new requirement is 687redundant to the existing specification, this has no effect. 688 689Minimum requirements are inclusive. C<$version> is required, along with any 690greater version number. 691 692This method returns the version range object. 693 694=head2 with_maximum 695 696 $range->with_maximum( $version ); 697 698This adds a new maximum version requirement. If the new requirement is 699redundant to the existing specification, this has no effect. 700 701Maximum requirements are inclusive. No version strictly greater than the given 702version is allowed. 703 704This method returns the version range object. 705 706=head2 with_exclusion 707 708 $range->with_exclusion( $version ); 709 710This adds a new excluded version. For example, you might use these three 711method calls: 712 713 $range->with_minimum( '1.00' ); 714 $range->with_maximum( '1.82' ); 715 716 $range->with_exclusion( '1.75' ); 717 718Any version between 1.00 and 1.82 inclusive would be acceptable, except for 7191.75. 720 721This method returns the requirements object. 722 723=head2 as_struct 724 725 $range->as_struct( $module ); 726 727This returns a data structure containing the version requirements. This should 728not be used for version checks (see L</accepts_module> instead). 729 730=head2 as_string 731 732 $range->as_string; 733 734This returns a string containing the version requirements in the format 735described in L<CPAN::Meta::Spec>. This should only be used for informational 736purposes such as error messages and should not be interpreted or used for 737comparison (see L</accepts> instead). 738 739=head2 accepts 740 741 my $bool = $range->accepts($version); 742 743Given a version, this method returns true if the version specification 744accepts the provided version. In other words, given: 745 746 '>= 1.00, < 2.00' 747 748We will accept 1.00 and 1.75 but not 0.50 or 2.00. 749 750=head2 is_simple 751 752This method returns true if and only if the range is an inclusive minimum 753-- that is, if their string expression is just the version number. 754 755=head1 AUTHORS 756 757=over 4 758 759=item * 760 761David Golden <dagolden@cpan.org> 762 763=item * 764 765Ricardo Signes <rjbs@cpan.org> 766 767=back 768 769=head1 COPYRIGHT AND LICENSE 770 771This software is copyright (c) 2010 by David Golden and Ricardo Signes. 772 773This is free software; you can redistribute it and/or modify it under 774the same terms as the Perl 5 programming language system itself. 775 776=cut 777