Profile of CPAN/Meta/Requirements.pm

← Index
NYTProf Performance Profile «line view»
For test.pl
Run on Mon Apr 5 14:31:27 2021
Reported on Mon Apr 5 14:31:40 2021

Filename | /home/leont/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0/CPAN/Meta/Requirements.pm
Statements | Executed 33 statements in 1.94ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 17µs | 20µs | CPAN::Meta::Requirements::::BEGIN@44 CPAN::Meta::Requirements::BEGIN@44
1 | 1 | 1 | 11µs | 11µs | CPAN::Meta::Requirements::::BEGIN@214 CPAN::Meta::Requirements::BEGIN@214
1 | 1 | 1 | 6µs | 6µs | CPAN::Meta::Prereqs::::BEGIN@1 CPAN::Meta::Prereqs::BEGIN@1
1 | 1 | 1 | 4µs | 13µs | CPAN::Meta::Requirements::::BEGIN@229 CPAN::Meta::Requirements::BEGIN@229
1 | 1 | 1 | 3µs | 10µs | CPAN::Meta::Prereqs::::BEGIN@3 CPAN::Meta::Prereqs::BEGIN@3
1 | 1 | 1 | 2µs | 4µs | CPAN::Meta::Prereqs::::BEGIN@2 CPAN::Meta::Prereqs::BEGIN@2
1 | 1 | 1 | 1µs | 1µs | CPAN::Meta::Requirements::::BEGIN@36 CPAN::Meta::Requirements::BEGIN@36
1 | 1 | 1 | 200ns | 200ns | CPAN::Meta::Prereqs::::__ANON__ CPAN::Meta::Prereqs::__ANON__ (xsub)
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::_acceptsCPAN::Meta::Requirements::_Range::Exact::_accepts
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::_cloneCPAN::Meta::Requirements::_Range::Exact::_clone
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::_newCPAN::Meta::Requirements::_Range::Exact::_new
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::_reject_requirementsCPAN::Meta::Requirements::_Range::Exact::_reject_requirements
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::as_modifiersCPAN::Meta::Requirements::_Range::Exact::as_modifiers
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::as_stringCPAN::Meta::Requirements::_Range::Exact::as_string
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::as_structCPAN::Meta::Requirements::_Range::Exact::as_struct
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::with_exact_versionCPAN::Meta::Requirements::_Range::Exact::with_exact_version
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::with_exclusionCPAN::Meta::Requirements::_Range::Exact::with_exclusion
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::with_maximumCPAN::Meta::Requirements::_Range::Exact::with_maximum
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Exact::::with_minimumCPAN::Meta::Requirements::_Range::Exact::with_minimum
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::_acceptsCPAN::Meta::Requirements::_Range::Range::_accepts
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::_cloneCPAN::Meta::Requirements::_Range::Range::_clone
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::_reject_requirementsCPAN::Meta::Requirements::_Range::Range::_reject_requirements
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::_selfCPAN::Meta::Requirements::_Range::Range::_self
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::_simplifyCPAN::Meta::Requirements::_Range::Range::_simplify
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::as_modifiersCPAN::Meta::Requirements::_Range::Range::as_modifiers
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::as_stringCPAN::Meta::Requirements::_Range::Range::as_string
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::as_structCPAN::Meta::Requirements::_Range::Range::as_struct
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::with_exact_versionCPAN::Meta::Requirements::_Range::Range::with_exact_version
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::with_exclusionCPAN::Meta::Requirements::_Range::Range::with_exclusion
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::with_maximumCPAN::Meta::Requirements::_Range::Range::with_maximum
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::_Range::Range::::with_minimumCPAN::Meta::Requirements::_Range::Range::with_minimum
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::__ANON__[:133] CPAN::Meta::Requirements::__ANON__[:133]
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::__ANON__[:227] CPAN::Meta::Requirements::__ANON__[:227]
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::__ANON__[:52] CPAN::Meta::Requirements::__ANON__[:52]
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::__entry_for CPAN::Meta::Requirements::__entry_for
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::__modify_entry_for CPAN::Meta::Requirements::__modify_entry_for
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::_blank_carp CPAN::Meta::Requirements::_blank_carp
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::_find_magic_vstring CPAN::Meta::Requirements::_find_magic_vstring
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::_isa_version CPAN::Meta::Requirements::_isa_version
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::_version_object CPAN::Meta::Requirements::_version_object
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::accepts_module CPAN::Meta::Requirements::accepts_module
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::add_minimum CPAN::Meta::Requirements::add_minimum
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::add_requirements CPAN::Meta::Requirements::add_requirements
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::add_string_requirement CPAN::Meta::Requirements::add_string_requirement
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::as_string_hash CPAN::Meta::Requirements::as_string_hash
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::clear_requirement CPAN::Meta::Requirements::clear_requirement
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::clone CPAN::Meta::Requirements::clone
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::finalize CPAN::Meta::Requirements::finalize
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::from_string_hash CPAN::Meta::Requirements::from_string_hash
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::is_finalized CPAN::Meta::Requirements::is_finalized
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::is_simple CPAN::Meta::Requirements::is_simple
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::new CPAN::Meta::Requirements::new
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::required_modules CPAN::Meta::Requirements::required_modules
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::requirements_for_module CPAN::Meta::Requirements::requirements_for_module
0 | 0 | 0 | 0s | 0s | CPAN::Meta::Requirements::::structured_requirements_for_module CPAN::Meta::Requirements::structured_requirements_for_module

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 | 2 | 19µs | 1 | 6µs | # spent 6µs within CPAN::Meta::Prereqs::BEGIN@1 which was called: # once (6µs+0s) by CPAN::Meta::Prereqs::BEGIN@18 at line 1 use 5.006; # keep at v5.6 for CPAN.pm # spent 6µs making 1 call to CPAN::Meta::Prereqs::BEGIN@1
2 | 2 | 9µs | 2 | 5µs | # spent 4µs (2+1) within CPAN::Meta::Prereqs::BEGIN@2 which was called: # once (2µs+1µs) by CPAN::Meta::Prereqs::BEGIN@18 at line 2 use strict; # spent 4µs making 1 call to CPAN::Meta::Prereqs::BEGIN@2 # spent 1µs making 1 call to strict::import
3 | 2 | 30µs | 2 | 17µs | # spent 10µs (3+7) within CPAN::Meta::Prereqs::BEGIN@3 which was called: # once (3µs+7µs) by CPAN::Meta::Prereqs::BEGIN@18 at line 3 use warnings; # spent 10µs making 1 call to CPAN::Meta::Prereqs::BEGIN@3 # spent 7µs making 1 call to warnings::import
4 |  |  |  |  | package CPAN::Meta::Requirements;
5 |  |  |  |  | # ABSTRACT: a set of version requirements for a CPAN dist
6 |  |  |  |  |
7 | 1 | 300ns |  |  | our $VERSION = '2.140';
8 |  |  |  |  |
9 |  |  |  |  | #pod =head1 SYNOPSIS
10 |  |  |  |  | #pod
11 |  |  |  |  | #pod use CPAN::Meta::Requirements;
12 |  |  |  |  | #pod
13 |  |  |  |  | #pod my $build_requires = CPAN::Meta::Requirements->new;
14 |  |  |  |  | #pod
15 |  |  |  |  | #pod $build_requires->add_minimum('Library::Foo' => 1.208);
16 |  |  |  |  | #pod
17 |  |  |  |  | #pod $build_requires->add_minimum('Library::Foo' => 2.602);
18 |  |  |  |  | #pod
19 |  |  |  |  | #pod $build_requires->add_minimum('Module::Bar' => 'v1.2.3');
20 |  |  |  |  | #pod
21 |  |  |  |  | #pod $METAyml->{build_requires} = $build_requires->as_string_hash;
22 |  |  |  |  | #pod
23 |  |  |  |  | #pod =head1 DESCRIPTION
24 |  |  |  |  | #pod
25 |  |  |  |  | #pod A CPAN::Meta::Requirements object models a set of version constraints like
26 |  |  |  |  | #pod those specified in the F<META.yml> or F<META.json> files in CPAN distributions,
27 |  |  |  |  | #pod and as defined by L<CPAN::Meta::Spec>;
28 |  |  |  |  | #pod It can be built up by adding more and more constraints, and it will reduce them
29 |  |  |  |  | #pod to the simplest representation.
30 |  |  |  |  | #pod
31 |  |  |  |  | #pod Logically impossible constraints will be identified immediately by thrown
32 |  |  |  |  | #pod exceptions.
33 |  |  |  |  | #pod
34 |  |  |  |  | #pod =cut
35 |  |  |  |  |
36 | 2 | 25µs | 1 | 1µs | # spent 1µs within CPAN::Meta::Requirements::BEGIN@36 which was called: # once (1µs+0s) by CPAN::Meta::Prereqs::BEGIN@18 at line 36 use Carp (); # spent 1µs making 1 call to CPAN::Meta::Requirements::BEGIN@36
37 |  |  |  |  |
38 |  |  |  |  | # To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls
39 |  |  |  |  | # before 5.10, we fall back to the EUMM bundled compatibility version module if
40 |  |  |  |  | # that's the only thing available. This shouldn't ever happen in a normal CPAN
41 |  |  |  |  | # install of CPAN::Meta::Requirements, as version.pm will be picked up from
42 |  |  |  |  | # prereqs and be available at runtime.
43 |  |  |  |  |
44 |  |  |  |  | # spent 20µs (17+3) within CPAN::Meta::Requirements::BEGIN@44 which was called: # once (17µs+3µs) by CPAN::Meta::Prereqs::BEGIN@18 at line 49 BEGIN {
45 | 1 | 13µs |  |  | eval "use version ()"; ## no critic # spent 6µs executing statements in string eval # includes 3µs spent executing 1 call to 1 sub defined therein.
46 | 1 | 2µs |  |  | if ( my $err = $@ ) {
47 |  |  |  |  | eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic
48 |  |  |  |  | }
49 | 1 | 439µs | 1 | 20µs | } # spent 20µs making 1 call to CPAN::Meta::Requirements::BEGIN@44
50 |  |  |  |  |
51 |  |  |  |  | # Perl 5.10.0 didn't have "is_qv" in version.pm
52 | 1 | 7µs | 1 | 1µs | *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; # spent 1µs making 1 call to UNIVERSAL::can
53 |  |  |  |  |
54 |  |  |  |  | # construct once, reuse many times
55 | 1 | 3µs | 1 | 2µs | my $V0 = version->new(0); # spent 2µs making 1 call to version::new
56 |  |  |  |  |
57 |  |  |  |  | #pod =method new
58 |  |  |  |  | #pod
59 |  |  |  |  | #pod my $req = CPAN::Meta::Requirements->new;
60 |  |  |  |  | #pod
61 |  |  |  |  | #pod This returns a new CPAN::Meta::Requirements object. It takes an optional
62 |  |  |  |  | #pod hash reference argument. Currently, only one key is supported:
63 |  |  |  |  | #pod
64 |  |  |  |  | #pod =for :list
65 |  |  |  |  | #pod * C<bad_version_hook> -- if provided, when a version cannot be parsed into
66 |  |  |  |  | #pod a version object, this code reference will be called with the invalid
67 |  |  |  |  | #pod version string as first argument, and the module name as second
68 |  |  |  |  | #pod argument. It must return a valid version object.
69 |  |  |  |  | #pod
70 |  |  |  |  | #pod All other keys are ignored.
71 |  |  |  |  | #pod
72 |  |  |  |  | #pod =cut
73 |  |  |  |  |
74 | 1 | 400ns |  |  | my @valid_options = qw( bad_version_hook );
75 |  |  |  |  |
76 |  |  |  |  | sub new {
77 |  |  |  |  | my ($class, $options) = @_;
78 |  |  |  |  | $options ||= {};
79 |  |  |  |  | Carp::croak "Argument to $class\->new() must be a hash reference"
80 |  |  |  |  | unless ref $options eq 'HASH';
81 |  |  |  |  | my %self = map {; $_ => $options->{$_}} @valid_options;
82 |  |  |  |  |
83 |  |  |  |  | return bless \%self => $class;
84 |  |  |  |  | }
85 |  |  |  |  |
86 |  |  |  |  | # from version::vpp
87 |  |  |  |  | sub _find_magic_vstring {
88 |  |  |  |  | my $value = shift;
89 |  |  |  |  | my $tvalue = '';
90 |  |  |  |  | require B;
91 |  |  |  |  | my $sv = B::svref_2object(\$value);
92 |  |  |  |  | my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
93 |  |  |  |  | while ( $magic ) {
94 |  |  |  |  | if ( $magic->TYPE eq 'V' ) {
95 |  |  |  |  | $tvalue = $magic->PTR;
96 |  |  |  |  | $tvalue =~ s/^v?(.+)$/v$1/;
97 |  |  |  |  | last;
98 |  |  |  |  | }
99 |  |  |  |  | else {
100 |  |  |  |  | $magic = $magic->MOREMAGIC;
101 |  |  |  |  | }
102 |  |  |  |  | }
103 |  |  |  |  | return $tvalue;
104 |  |  |  |  | }
105 |  |  |  |  |
106 |  |  |  |  | # safe if given an unblessed reference
107 |  |  |  |  | sub _isa_version {
108 |  |  |  |  | UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version')
109 |  |  |  |  | }
110 |  |  |  |  |
111 |  |  |  |  | sub _version_object {
112 |  |  |  |  | my ($self, $module, $version) = @_;
113 |  |  |  |  |
114 |  |  |  |  | my ($vobj, $err);
115 |  |  |  |  |
116 |  |  |  |  | if (not defined $version or (!ref($version) && $version eq '0')) {
117 |  |  |  |  | return $V0;
118 |  |  |  |  | }
119 |  |  |  |  | elsif ( ref($version) eq 'version' || ( ref($version) && _isa_version($version) ) ) {
120 |  |  |  |  | $vobj = $version;
121 |  |  |  |  | }
122 |  |  |  |  | else {
123 |  |  |  |  | # hack around version::vpp not handling <3 character vstring literals
124 |  |  |  |  | if ( $INC{'version/vpp.pm'} || $INC{'ExtUtils/MakeMaker/version/vpp.pm'} ) {
125 |  |  |  |  | my $magic = _find_magic_vstring( $version );
126 |  |  |  |  | $version = $magic if length $magic;
127 |  |  |  |  | }
128 |  |  |  |  | # pad to 3 characters if before 5.8.1 and appears to be a v-string
129 |  |  |  |  | if ( $] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1) ne 'v' && length($version) < 3 ) {
130 |  |  |  |  | $version .= "\0" x (3 - length($version));
131 |  |  |  |  | }
132 |  |  |  |  | eval {
133 |  |  |  |  | local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" };
134 |  |  |  |  | # avoid specific segfault on some older version.pm versions
135 |  |  |  |  | die "Invalid version: $version" if $version eq 'version';
136 |  |  |  |  | $vobj = version->new($version);
137 |  |  |  |  | };
138 |  |  |  |  | if ( my $err = $@ ) {
139 |  |  |  |  | my $hook = $self->{bad_version_hook};
140 |  |  |  |  | $vobj = eval { $hook->($version, $module) }
141 |  |  |  |  | if ref $hook eq 'CODE';
142 |  |  |  |  | unless (eval { $vobj->isa("version") }) {
143 |  |  |  |  | $err =~ s{ at .* line \d+.*$}{};
144 |  |  |  |  | die "Can't convert '$version': $err";
145 |  |  |  |  | }
146 |  |  |  |  | }
147 |  |  |  |  | }
148 |  |  |  |  |
149 |  |  |  |  | # ensure no leading '.'
150 |  |  |  |  | if ( $vobj =~ m{\A\.} ) {
151 |  |  |  |  | $vobj = version->new("0$vobj");
152 |  |  |  |  | }
153 |  |  |  |  |
154 |  |  |  |  | # ensure normal v-string form
155 |  |  |  |  | if ( _is_qv($vobj) ) {
156 |  |  |  |  | $vobj = version->new($vobj->normal);
157 |  |  |  |  | }
158 |  |  |  |  |
159 |  |  |  |  | return $vobj;
160 |  |  |  |  | }
161 |  |  |  |  |
162 |  |  |  |  | #pod =method add_minimum
163 |  |  |  |  | #pod
164 |  |  |  |  | #pod $req->add_minimum( $module => $version );
165 |  |  |  |  | #pod
166 |  |  |  |  | #pod This adds a new minimum version requirement. If the new requirement is
167 |  |  |  |  | #pod redundant to the existing specification, this has no effect.
168 |  |  |  |  | #pod
169 |  |  |  |  | #pod Minimum requirements are inclusive. C<$version> is required, along with any
170 |  |  |  |  | #pod greater version number.
171 |  |  |  |  | #pod
172 |  |  |  |  | #pod This method returns the requirements object.
173 |  |  |  |  | #pod
174 |  |  |  |  | #pod =method add_maximum
175 |  |  |  |  | #pod
176 |  |  |  |  | #pod $req->add_maximum( $module => $version );
177 |  |  |  |  | #pod
178 |  |  |  |  | #pod This adds a new maximum version requirement. If the new requirement is
179 |  |  |  |  | #pod redundant to the existing specification, this has no effect.
180 |  |  |  |  | #pod
181 |  |  |  |  | #pod Maximum requirements are inclusive. No version strictly greater than the given
182 |  |  |  |  | #pod version is allowed.
183 |  |  |  |  | #pod
184 |  |  |  |  | #pod This method returns the requirements object.
185 |  |  |  |  | #pod
186 |  |  |  |  | #pod =method add_exclusion
187 |  |  |  |  | #pod
188 |  |  |  |  | #pod $req->add_exclusion( $module => $version );
189 |  |  |  |  | #pod
190 |  |  |  |  | #pod This adds a new excluded version. For example, you might use these three
191 |  |  |  |  | #pod method calls:
192 |  |  |  |  | #pod
193 |  |  |  |  | #pod $req->add_minimum( $module => '1.00' );
194 |  |  |  |  | #pod $req->add_maximum( $module => '1.82' );
195 |  |  |  |  | #pod
196 |  |  |  |  | #pod $req->add_exclusion( $module => '1.75' );
197 |  |  |  |  | #pod
198 |  |  |  |  | #pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for
199 |  |  |  |  | #pod 1.75.
200 |  |  |  |  | #pod
201 |  |  |  |  | #pod This method returns the requirements object.
202 |  |  |  |  | #pod
203 |  |  |  |  | #pod =method exact_version
204 |  |  |  |  | #pod
205 |  |  |  |  | #pod $req->exact_version( $module => $version );
206 |  |  |  |  | #pod
207 |  |  |  |  | #pod This sets the version required for the given module to I<exactly> the given
208 |  |  |  |  | #pod version. No other version would be considered acceptable.
209 |  |  |  |  | #pod
210 |  |  |  |  | #pod This method returns the requirements object.
211 |  |  |  |  | #pod
212 |  |  |  |  | #pod =cut
213 |  |  |  |  |
214 |  |  |  |  | # spent 11µs within CPAN::Meta::Requirements::BEGIN@214 which was called: # once (11µs+0s) by CPAN::Meta::Prereqs::BEGIN@18 at line 232 BEGIN {
215 | 1 | 2µs |  |  | for my $type (qw(maximum exclusion exact_version)) {
216 | 3 | 900ns |  |  | my $method = "with_$type";
217 | 3 | 1µs |  |  | my $to_add = $type eq 'exact_version' ? $type : "add_$type";
218 |  |  |  |  |
219 |  |  |  |  | my $code = sub {
220 |  |  |  |  | my ($self, $name, $version) = @_;
221 |  |  |  |  |
222 |  |  |  |  | $version = $self->_version_object( $name, $version );
223 |  |  |  |  |
224 |  |  |  |  | $self->__modify_entry_for($name, $method, $version);
225 |  |  |  |  |
226 |  |  |  |  | return $self;
227 | 3 | 4µs |  |  | };
228 |  |  |  |  |
229 | 2 | 17µs | 2 | 22µs | # spent 13µs (4+9) within CPAN::Meta::Requirements::BEGIN@229 which was called: # once (4µs+9µs) by CPAN::Meta::Prereqs::BEGIN@18 at line 229 no strict 'refs'; # spent 13µs making 1 call to CPAN::Meta::Requirements::BEGIN@229 # spent 9µs making 1 call to strict::unimport
230 | 3 | 3µs |  |  | *$to_add = $code;
231 |  |  |  |  | }
232 | 1 | 1.35ms | 1 | 11µs | } # spent 11µs making 1 call to CPAN::Meta::Requirements::BEGIN@214
233 |  |  |  |  |
234 |  |  |  |  | # add_minimum is optimized compared to generated subs above because
235 |  |  |  |  | # it is called frequently and with "0" or equivalent input
236 |  |  |  |  | sub add_minimum {
237 |  |  |  |  | my ($self, $name, $version) = @_;
238 |  |  |  |  |
239 |  |  |  |  | # stringify $version so that version->new("0.00")->stringify ne "0"
240 |  |  |  |  | # which preserves the user's choice of "0.00" as the requirement
241 |  |  |  |  | if (not defined $version or "$version" eq '0') {
242 |  |  |  |  | return $self if $self->__entry_for($name);
243 |  |  |  |  | Carp::confess("can't add new requirements to finalized requirements")
244 |  |  |  |  | if $self->is_finalized;
245 |  |  |  |  |
246 |  |  |  |  | $self->{requirements}{ $name } =
247 |  |  |  |  | CPAN::Meta::Requirements::_Range::Range->with_minimum($V0, $name);
248 |  |  |  |  | }
249 |  |  |  |  | else {
250 |  |  |  |  | $version = $self->_version_object( $name, $version );
251 |  |  |  |  |
252 |  |  |  |  | $self->__modify_entry_for($name, 'with_minimum', $version);
253 |  |  |  |  | }
254 |  |  |  |  | return $self;
255 |  |  |  |  | }
256 |  |  |  |  |
257 |  |  |  |  | #pod =method add_requirements
258 |  |  |  |  | #pod
259 |  |  |  |  | #pod $req->add_requirements( $another_req_object );
260 |  |  |  |  | #pod
261 |  |  |  |  | #pod This method adds all the requirements in the given CPAN::Meta::Requirements
262 |  |  |  |  | #pod object to the requirements object on which it was called. If there are any
263 |  |  |  |  | #pod conflicts, an exception is thrown.
264 |  |  |  |  | #pod
265 |  |  |  |  | #pod This method returns the requirements object.
266 |  |  |  |  | #pod
267 |  |  |  |  | #pod =cut
268 |  |  |  |  |
269 |  |  |  |  | sub add_requirements {
270 |  |  |  |  | my ($self, $req) = @_;
271 |  |  |  |  |
272 |  |  |  |  | for my $module ($req->required_modules) {
273 |  |  |  |  | my $modifiers = $req->__entry_for($module)->as_modifiers;
274 |  |  |  |  | for my $modifier (@$modifiers) {
275 |  |  |  |  | my ($method, @args) = @$modifier;
276 |  |  |  |  | $self->$method($module => @args);
277 |  |  |  |  | };
278 |  |  |  |  | }
279 |  |  |  |  |
280 |  |  |  |  | return $self;
281 |  |  |  |  | }
282 |  |  |  |  |
283 |  |  |  |  | #pod =method accepts_module
284 |  |  |  |  | #pod
285 |  |  |  |  | #pod my $bool = $req->accepts_module($module => $version);
286 |  |  |  |  | #pod
287 |  |  |  |  | #pod Given an module and version, this method returns true if the version
288 |  |  |  |  | #pod specification for the module accepts the provided version. In other words,
289 |  |  |  |  | #pod given:
290 |  |  |  |  | #pod
291 |  |  |  |  | #pod Module => '>= 1.00, < 2.00'
292 |  |  |  |  | #pod
293 |  |  |  |  | #pod We will accept 1.00 and 1.75 but not 0.50 or 2.00.
294 |  |  |  |  | #pod
295 |  |  |  |  | #pod For modules that do not appear in the requirements, this method will return
296 |  |  |  |  | #pod true.
297 |  |  |  |  | #pod
298 |  |  |  |  | #pod =cut
299 |  |  |  |  |
300 |  |  |  |  | sub accepts_module {
301 |  |  |  |  | my ($self, $module, $version) = @_;
302 |  |  |  |  |
303 |  |  |  |  | $version = $self->_version_object( $module, $version );
304 |  |  |  |  |
305 |  |  |  |  | return 1 unless my $range = $self->__entry_for($module);
306 |  |  |  |  | return $range->_accepts($version);
307 |  |  |  |  | }
308 |  |  |  |  |
309 |  |  |  |  | #pod =method clear_requirement
310 |  |  |  |  | #pod
311 |  |  |  |  | #pod $req->clear_requirement( $module );
312 |  |  |  |  | #pod
313 |  |  |  |  | #pod This removes the requirement for a given module from the object.
314 |  |  |  |  | #pod
315 |  |  |  |  | #pod This method returns the requirements object.
316 |  |  |  |  | #pod
317 |  |  |  |  | #pod =cut
318 |  |  |  |  |
319 |  |  |  |  | sub clear_requirement {
320 |  |  |  |  | my ($self, $module) = @_;
321 |  |  |  |  |
322 |  |  |  |  | return $self unless $self->__entry_for($module);
323 |  |  |  |  |
324 |  |  |  |  | Carp::confess("can't clear requirements on finalized requirements")
325 |  |  |  |  | if $self->is_finalized;
326 |  |  |  |  |
327 |  |  |  |  | delete $self->{requirements}{ $module };
328 |  |  |  |  |
329 |  |  |  |  | return $self;
330 |  |  |  |  | }
331 |  |  |  |  |
332 |  |  |  |  | #pod =method requirements_for_module
333 |  |  |  |  | #pod
334 |  |  |  |  | #pod $req->requirements_for_module( $module );
335 |  |  |  |  | #pod
336 |  |  |  |  | #pod This returns a string containing the version requirements for a given module in
337 |  |  |  |  | #pod the format described in L<CPAN::Meta::Spec> or undef if the given module has no
338 |  |  |  |  | #pod requirements. This should only be used for informational purposes such as error
339 |  |  |  |  | #pod messages and should not be interpreted or used for comparison (see
340 |  |  |  |  | #pod L</accepts_module> instead).
341 |  |  |  |  | #pod
342 |  |  |  |  | #pod =cut
343 |  |  |  |  |
344 |  |  |  |  | sub requirements_for_module {
345 |  |  |  |  | my ($self, $module) = @_;
346 |  |  |  |  | my $entry = $self->__entry_for($module);
347 |  |  |  |  | return unless $entry;
348 |  |  |  |  | return $entry->as_string;
349 |  |  |  |  | }
350 |  |  |  |  |
351 |  |  |  |  | #pod =method structured_requirements_for_module
352 |  |  |  |  | #pod
353 |  |  |  |  | #pod $req->structured_requirements_for_module( $module );
354 |  |  |  |  | #pod
355 |  |  |  |  | #pod This returns a data structure containing the version requirements for a given
356 |  |  |  |  | #pod module or undef if the given module has no requirements. This should
357 |  |  |  |  | #pod not be used for version checks (see L</accepts_module> instead).
358 |  |  |  |  | #pod
359 |  |  |  |  | #pod Added in version 2.134.
360 |  |  |  |  | #pod
361 |  |  |  |  | #pod =cut
362 |  |  |  |  |
363 |  |  |  |  | sub structured_requirements_for_module {
364 |  |  |  |  | my ($self, $module) = @_;
365 |  |  |  |  | my $entry = $self->__entry_for($module);
366 |  |  |  |  | return unless $entry;
367 |  |  |  |  | return $entry->as_struct;
368 |  |  |  |  | }
369 |  |  |  |  |
370 |  |  |  |  | #pod =method required_modules
371 |  |  |  |  | #pod
372 |  |  |  |  | #pod This method returns a list of all the modules for which requirements have been
373 |  |  |  |  | #pod specified.
374 |  |  |  |  | #pod
375 |  |  |  |  | #pod =cut
376 |  |  |  |  |
377 |  |  |  |  | sub required_modules { keys %{ $_[0]{requirements} } }
378 |  |  |  |  |
379 |  |  |  |  | #pod =method clone
380 |  |  |  |  | #pod
381 |  |  |  |  | #pod $req->clone;
382 |  |  |  |  | #pod
383 |  |  |  |  | #pod This method returns a clone of the invocant. The clone and the original object
384 |  |  |  |  | #pod can then be changed independent of one another.
385 |  |  |  |  | #pod
386 |  |  |  |  | #pod =cut
387 |  |  |  |  |
388 |  |  |  |  | sub clone {
389 |  |  |  |  | my ($self) = @_;
390 |  |  |  |  | my $new = (ref $self)->new;
391 |  |  |  |  |
392 |  |  |  |  | return $new->add_requirements($self);
393 |  |  |  |  | }
394 |  |  |  |  |
395 |  |  |  |  | sub __entry_for { $_[0]{requirements}{ $_[1] } }
396 |  |  |  |  |
397 |  |  |  |  | sub __modify_entry_for {
398 |  |  |  |  | my ($self, $name, $method, $version) = @_;
399 |  |  |  |  |
400 |  |  |  |  | my $fin = $self->is_finalized;
401 |  |  |  |  | my $old = $self->__entry_for($name);
402 |  |  |  |  |
403 |  |  |  |  | Carp::confess("can't add new requirements to finalized requirements")
404 |  |  |  |  | if $fin and not $old;
405 |  |  |  |  |
406 |  |  |  |  | my $new = ($old || 'CPAN::Meta::Requirements::_Range::Range')
407 |  |  |  |  | ->$method($version, $name);
408 |  |  |  |  |
409 |  |  |  |  | Carp::confess("can't modify finalized requirements")
410 |  |  |  |  | if $fin and $old->as_string ne $new->as_string;
411 |  |  |  |  |
412 |  |  |  |  | $self->{requirements}{ $name } = $new;
413 |  |  |  |  | }
414 |  |  |  |  |
415 |  |  |  |  | #pod =method is_simple
416 |  |  |  |  | #pod
417 |  |  |  |  | #pod This method returns true if and only if all requirements are inclusive minimums
418 |  |  |  |  | #pod -- that is, if their string expression is just the version number.
419 |  |  |  |  | #pod
420 |  |  |  |  | #pod =cut
421 |  |  |  |  |
422 |  |  |  |  | sub is_simple {
423 |  |  |  |  | my ($self) = @_;
424 |  |  |  |  | for my $module ($self->required_modules) {
425 |  |  |  |  | # XXX: This is a complete hack, but also entirely correct.
426 |  |  |  |  | return if $self->__entry_for($module)->as_string =~ /\s/;
427 |  |  |  |  | }
428 |  |  |  |  |
429 |  |  |  |  | return 1;
430 |  |  |  |  | }
431 |  |  |  |  |
432 |  |  |  |  | #pod =method is_finalized
433 |  |  |  |  | #pod
434 |  |  |  |  | #pod This method returns true if the requirements have been finalized by having the
435 |  |  |  |  | #pod C<finalize> method called on them.
436 |  |  |  |  | #pod
437 |  |  |  |  | #pod =cut
438 |  |  |  |  |
439 |  |  |  |  | sub is_finalized { $_[0]{finalized} }
440 |  |  |  |  |
441 |  |  |  |  | #pod =method finalize
442 |  |  |  |  | #pod
443 |  |  |  |  | #pod This method marks the requirements finalized. Subsequent attempts to change
444 |  |  |  |  | #pod the requirements will be fatal, I<if> they would result in a change. If they
445 |  |  |  |  | #pod would not alter the requirements, they have no effect.
446 |  |  |  |  | #pod
447 |  |  |  |  | #pod If a finalized set of requirements is cloned, the cloned requirements are not
448 |  |  |  |  | #pod also finalized.
449 |  |  |  |  | #pod
450 |  |  |  |  | #pod =cut
451 |  |  |  |  |
452 |  |  |  |  | sub finalize { $_[0]{finalized} = 1 }
453 |  |  |  |  |
454 |  |  |  |  | #pod =method as_string_hash
455 |  |  |  |  | #pod
456 |  |  |  |  | #pod This returns a reference to a hash describing the requirements using the
457 |  |  |  |  | #pod strings in the L<CPAN::Meta::Spec> specification.
458 |  |  |  |  | #pod
459 |  |  |  |  | #pod For example after the following program:
460 |  |  |  |  | #pod
461 |  |  |  |  | #pod my $req = CPAN::Meta::Requirements->new;
462 |  |  |  |  | #pod
463 |  |  |  |  | #pod $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
464 |  |  |  |  | #pod
465 |  |  |  |  | #pod $req->add_minimum('Library::Foo' => 1.208);
466 |  |  |  |  | #pod
467 |  |  |  |  | #pod $req->add_maximum('Library::Foo' => 2.602);
468 |  |  |  |  | #pod
469 |  |  |  |  | #pod $req->add_minimum('Module::Bar' => 'v1.2.3');
470 |  |  |  |  | #pod
471 |  |  |  |  | #pod $req->add_exclusion('Module::Bar' => 'v1.2.8');
472 |  |  |  |  | #pod
473 |  |  |  |  | #pod $req->exact_version('Xyzzy' => '6.01');
474 |  |  |  |  | #pod
475 |  |  |  |  | #pod my $hashref = $req->as_string_hash;
476 |  |  |  |  | #pod
477 |  |  |  |  | #pod C<$hashref> would contain:
478 |  |  |  |  | #pod
479 |  |  |  |  | #pod {
480 |  |  |  |  | #pod 'CPAN::Meta::Requirements' => '0.102',
481 |  |  |  |  | #pod 'Library::Foo' => '>= 1.208, <= 2.206',
482 |  |  |  |  | #pod 'Module::Bar' => '>= v1.2.3, != v1.2.8',
483 |  |  |  |  | #pod 'Xyzzy' => '== 6.01',
484 |  |  |  |  | #pod }
485 |  |  |  |  | #pod
486 |  |  |  |  | #pod =cut
487 |  |  |  |  |
488 |  |  |  |  | sub as_string_hash {
489 |  |  |  |  | my ($self) = @_;
490 |  |  |  |  |
491 |  |  |  |  | my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
492 |  |  |  |  | $self->required_modules;
493 |  |  |  |  |
494 |  |  |  |  | return \%hash;
495 |  |  |  |  | }
496 |  |  |  |  |
497 |  |  |  |  | #pod =method add_string_requirement
498 |  |  |  |  | #pod
499 |  |  |  |  | #pod $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
500 |  |  |  |  | #pod $req->add_string_requirement('Library::Foo' => v1.208);
501 |  |  |  |  | #pod
502 |  |  |  |  | #pod This method parses the passed in string and adds the appropriate requirement
503 |  |  |  |  | #pod for the given module. A version can be a Perl "v-string". It understands
504 |  |  |  |  | #pod version ranges as described in the L<CPAN::Meta::Spec/Version Ranges>. For
505 |  |  |  |  | #pod example:
506 |  |  |  |  | #pod
507 |  |  |  |  | #pod =over 4
508 |  |  |  |  | #pod
509 |  |  |  |  | #pod =item 1.3
510 |  |  |  |  | #pod
511 |  |  |  |  | #pod =item >= 1.3
512 |  |  |  |  | #pod
513 |  |  |  |  | #pod =item <= 1.3
514 |  |  |  |  | #pod
515 |  |  |  |  | #pod =item == 1.3
516 |  |  |  |  | #pod
517 |  |  |  |  | #pod =item != 1.3
518 |  |  |  |  | #pod
519 |  |  |  |  | #pod =item > 1.3
520 |  |  |  |  | #pod
521 |  |  |  |  | #pod =item < 1.3
522 |  |  |  |  | #pod
523 |  |  |  |  | #pod =item >= 1.3, != 1.5, <= 2.0
524 |  |  |  |  | #pod
525 |  |  |  |  | #pod A version number without an operator is equivalent to specifying a minimum
526 |  |  |  |  | #pod (C<E<gt>=>). Extra whitespace is allowed.
527 |  |  |  |  | #pod
528 |  |  |  |  | #pod =back
529 |  |  |  |  | #pod
530 |  |  |  |  | #pod =cut
531 |  |  |  |  |
532 | 1 | 2µs |  |  | my %methods_for_op = (
533 |  |  |  |  | '==' => [ qw(exact_version) ],
534 |  |  |  |  | '!=' => [ qw(add_exclusion) ],
535 |  |  |  |  | '>=' => [ qw(add_minimum) ],
536 |  |  |  |  | '<=' => [ qw(add_maximum) ],
537 |  |  |  |  | '>' => [ qw(add_minimum add_exclusion) ],
538 |  |  |  |  | '<' => [ qw(add_maximum add_exclusion) ],
539 |  |  |  |  | );
540 |  |  |  |  |
541 |  |  |  |  | sub add_string_requirement {
542 |  |  |  |  | my ($self, $module, $req) = @_;
543 |  |  |  |  |
544 |  |  |  |  | unless ( defined $req && length $req ) {
545 |  |  |  |  | $req = 0;
546 |  |  |  |  | $self->_blank_carp($module);
547 |  |  |  |  | }
548 |  |  |  |  |
549 |  |  |  |  | my $magic = _find_magic_vstring( $req );
550 |  |  |  |  | if (length $magic) {
551 |  |  |  |  | $self->add_minimum($module => $magic);
552 |  |  |  |  | return;
553 |  |  |  |  | }
554 |  |  |  |  |
555 |  |  |  |  | my @parts = split qr{\s*,\s*}, $req;
556 |  |  |  |  |
557 |  |  |  |  | for my $part (@parts) {
558 |  |  |  |  | my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};
559 |  |  |  |  |
560 |  |  |  |  | if (! defined $op) {
561 |  |  |  |  | $self->add_minimum($module => $part);
562 |  |  |  |  | } else {
563 |  |  |  |  | Carp::confess("illegal requirement string: $req")
564 |  |  |  |  | unless my $methods = $methods_for_op{ $op };
565 |  |  |  |  |
566 |  |  |  |  | $self->$_($module => $ver) for @$methods;
567 |  |  |  |  | }
568 |  |  |  |  | }
569 |  |  |  |  | }
570 |  |  |  |  |
571 |  |  |  |  | #pod =method from_string_hash
572 |  |  |  |  | #pod
573 |  |  |  |  | #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
574 |  |  |  |  | #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts );
575 |  |  |  |  | #pod
576 |  |  |  |  | #pod This is an alternate constructor for a CPAN::Meta::Requirements
577 |  |  |  |  | #pod object. It takes a hash of module names and version requirement
578 |  |  |  |  | #pod strings and returns a new CPAN::Meta::Requirements object. As with
579 |  |  |  |  | #pod add_string_requirement, a version can be a Perl "v-string". Optionally,
580 |  |  |  |  | #pod you can supply a hash-reference of options, exactly as with the L</new>
581 |  |  |  |  | #pod method.
582 |  |  |  |  | #pod
583 |  |  |  |  | #pod =cut
584 |  |  |  |  |
585 |  |  |  |  | sub _blank_carp {
586 |  |  |  |  | my ($self, $module) = @_;
587 |  |  |  |  | Carp::carp("Undefined requirement for $module treated as '0'");
588 |  |  |  |  | }
589 |  |  |  |  |
590 |  |  |  |  | sub from_string_hash {
591 |  |  |  |  | my ($class, $hash, $options) = @_;
592 |  |  |  |  |
593 |  |  |  |  | my $self = $class->new($options);
594 |  |  |  |  |
595 |  |  |  |  | for my $module (keys %$hash) {
596 |  |  |  |  | my $req = $hash->{$module};
597 |  |  |  |  | unless ( defined $req && length $req ) {
598 |  |  |  |  | $req = 0;
599 |  |  |  |  | $class->_blank_carp($module);
600 |  |  |  |  | }
601 |  |  |  |  | $self->add_string_requirement($module, $req);
602 |  |  |  |  | }
603 |  |  |  |  |
604 |  |  |  |  | return $self;
605 |  |  |  |  | }
606 |  |  |  |  |
607 |  |  |  |  | ##############################################################
608 |  |  |  |  |
609 |  |  |  |  | {
610 |  |  |  |  | package
611 |  |  |  |  | CPAN::Meta::Requirements::_Range::Exact;
612 |  |  |  |  | sub _new { bless { version => $_[1] } => $_[0] }
613 |  |  |  |  |
614 |  |  |  |  | sub _accepts { return $_[0]{version} == $_[1] }
615 |  |  |  |  |
616 |  |  |  |  | sub as_string { return "== $_[0]{version}" }
617 |  |  |  |  |
618 |  |  |  |  | sub as_struct { return [ [ '==', "$_[0]{version}" ] ] }
619 |  |  |  |  |
620 |  |  |  |  | sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] }
621 |  |  |  |  |
622 |  |  |  |  | sub _reject_requirements {
623 |  |  |  |  | my ($self, $module, $error) = @_;
624 |  |  |  |  | Carp::confess("illegal requirements for $module: $error")
625 |  |  |  |  | }
626 |  |  |  |  |
627 |  |  |  |  | sub _clone {
628 |  |  |  |  | (ref $_[0])->_new( version->new( $_[0]{version} ) )
629 |  |  |  |  | }
630 |  |  |  |  |
631 |  |  |  |  | sub with_exact_version {
632 |  |  |  |  | my ($self, $version, $module) = @_;
633 |  |  |  |  | $module = 'module' unless defined $module;
634 |  |  |  |  |
635 |  |  |  |  | return $self->_clone if $self->_accepts($version);
636 |  |  |  |  |
637 |  |  |  |  | $self->_reject_requirements(
638 |  |  |  |  | $module,
639 |  |  |  |  | "can't be exactly $version when exact requirement is already $self->{version}",
640 |  |  |  |  | );
641 |  |  |  |  | }
642 |  |  |  |  |
643 |  |  |  |  | sub with_minimum {
644 |  |  |  |  | my ($self, $minimum, $module) = @_;
645 |  |  |  |  | $module = 'module' unless defined $module;
646 |  |  |  |  |
647 |  |  |  |  | return $self->_clone if $self->{version} >= $minimum;
648 |  |  |  |  | $self->_reject_requirements(
649 |  |  |  |  | $module,
650 |  |  |  |  | "minimum $minimum exceeds exact specification $self->{version}",
651 |  |  |  |  | );
652 |  |  |  |  | }
653 |  |  |  |  |
654 |  |  |  |  | sub with_maximum {
655 |  |  |  |  | my ($self, $maximum, $module) = @_;
656 |  |  |  |  | $module = 'module' unless defined $module;
657 |  |  |  |  |
658 |  |  |  |  | return $self->_clone if $self->{version} <= $maximum;
659 |  |  |  |  | $self->_reject_requirements(
660 |  |  |  |  | $module,
661 |  |  |  |  | "maximum $maximum below exact specification $self->{version}",
662 |  |  |  |  | );
663 |  |  |  |  | }
664 |  |  |  |  |
665 |  |  |  |  | sub with_exclusion {
666 |  |  |  |  | my ($self, $exclusion, $module) = @_;
667 |  |  |  |  | $module = 'module' unless defined $module;
668 |  |  |  |  |
669 |  |  |  |  | return $self->_clone unless $exclusion == $self->{version};
670 |  |  |  |  | $self->_reject_requirements(
671 |  |  |  |  | $module,
672 |  |  |  |  | "tried to exclude $exclusion, which is already exactly specified",
673 |  |  |  |  | );
674 |  |  |  |  | }
675 |  |  |  |  | }
676 |  |  |  |  |
677 |  |  |  |  | ##############################################################
678 |  |  |  |  |
679 |  |  |  |  | {
680 | 1 | 300ns |  |  | package
681 |  |  |  |  | CPAN::Meta::Requirements::_Range::Range;
682 |  |  |  |  |
683 |  |  |  |  | sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) }
684 |  |  |  |  |
685 |  |  |  |  | sub _clone {
686 |  |  |  |  | return (bless { } => $_[0]) unless ref $_[0];
687 |  |  |  |  |
688 |  |  |  |  | my ($s) = @_;
689 |  |  |  |  | my %guts = (
690 |  |  |  |  | (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()),
691 |  |  |  |  | (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()),
692 |  |  |  |  |
693 |  |  |  |  | (exists $s->{exclusions}
694 |  |  |  |  | ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ])
695 |  |  |  |  | : ()),
696 |  |  |  |  | );
697 |  |  |  |  |
698 |  |  |  |  | bless \%guts => ref($s);
699 |  |  |  |  | }
700 |  |  |  |  |
701 |  |  |  |  | sub as_modifiers {
702 |  |  |  |  | my ($self) = @_;
703 |  |  |  |  | my @mods;
704 |  |  |  |  | push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum};
705 |  |  |  |  | push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum};
706 |  |  |  |  | push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []};
707 |  |  |  |  | return \@mods;
708 |  |  |  |  | }
709 |  |  |  |  |
710 |  |  |  |  | sub as_struct {
711 |  |  |  |  | my ($self) = @_;
712 |  |  |  |  |
713 |  |  |  |  | return 0 if ! keys %$self;
714 |  |  |  |  |
715 |  |  |  |  | my @exclusions = @{ $self->{exclusions} || [] };
716 |  |  |  |  |
717 |  |  |  |  | my @parts;
718 |  |  |  |  |
719 |  |  |  |  | for my $tuple (
720 |  |  |  |  | [ qw( >= > minimum ) ],
721 |  |  |  |  | [ qw( <= < maximum ) ],
722 |  |  |  |  | ) {
723 |  |  |  |  | my ($op, $e_op, $k) = @$tuple;
724 |  |  |  |  | if (exists $self->{$k}) {
725 |  |  |  |  | my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions;
726 |  |  |  |  | if (@new_exclusions == @exclusions) {
727 |  |  |  |  | push @parts, [ $op, "$self->{ $k }" ];
728 |  |  |  |  | } else {
729 |  |  |  |  | push @parts, [ $e_op, "$self->{ $k }" ];
730 |  |  |  |  | @exclusions = @new_exclusions;
731 |  |  |  |  | }
732 |  |  |  |  | }
733 |  |  |  |  | }
734 |  |  |  |  |
735 |  |  |  |  | push @parts, map {; [ "!=", "$_" ] } @exclusions;
736 |  |  |  |  |
737 |  |  |  |  | return \@parts;
738 |  |  |  |  | }
739 |  |  |  |  |
740 |  |  |  |  | sub as_string {
741 |  |  |  |  | my ($self) = @_;
742 |  |  |  |  |
743 |  |  |  |  | my @parts = @{ $self->as_struct };
744 |  |  |  |  |
745 |  |  |  |  | return $parts[0][1] if @parts == 1 and $parts[0][0] eq '>=';
746 |  |  |  |  |
747 |  |  |  |  | return join q{, }, map {; join q{ }, @$_ } @parts;
748 |  |  |  |  | }
749 |  |  |  |  |
750 |  |  |  |  | sub _reject_requirements {
751 |  |  |  |  | my ($self, $module, $error) = @_;
752 |  |  |  |  | Carp::confess("illegal requirements for $module: $error")
753 |  |  |  |  | }
754 |  |  |  |  |
755 |  |  |  |  | sub with_exact_version {
756 |  |  |  |  | my ($self, $version, $module) = @_;
757 |  |  |  |  | $module = 'module' unless defined $module;
758 |  |  |  |  | $self = $self->_clone;
759 |  |  |  |  |
760 |  |  |  |  | unless ($self->_accepts($version)) {
761 |  |  |  |  | $self->_reject_requirements(
762 |  |  |  |  | $module,
763 |  |  |  |  | "exact specification $version outside of range " . $self->as_string
764 |  |  |  |  | );
765 |  |  |  |  | }
766 |  |  |  |  |
767 |  |  |  |  | return CPAN::Meta::Requirements::_Range::Exact->_new($version);
768 |  |  |  |  | }
769 |  |  |  |  |
770 |  |  |  |  | sub _simplify {
771 |  |  |  |  | my ($self, $module) = @_;
772 |  |  |  |  |
773 |  |  |  |  | if (defined $self->{minimum} and defined $self->{maximum}) {
774 |  |  |  |  | if ($self->{minimum} == $self->{maximum}) {
775 |  |  |  |  | if (grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] }) {
776 |  |  |  |  | $self->_reject_requirements(
777 |  |  |  |  | $module,
778 |  |  |  |  | "minimum and maximum are both $self->{minimum}, which is excluded",
779 |  |  |  |  | );
780 |  |  |  |  | }
781 |  |  |  |  |
782 |  |  |  |  | return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})
783 |  |  |  |  | }
784 |  |  |  |  |
785 |  |  |  |  | if ($self->{minimum} > $self->{maximum}) {
786 |  |  |  |  | $self->_reject_requirements(
787 |  |  |  |  | $module,
788 |  |  |  |  | "minimum $self->{minimum} exceeds maximum $self->{maximum}",
789 |  |  |  |  | );
790 |  |  |  |  | }
791 |  |  |  |  | }
792 |  |  |  |  |
793 |  |  |  |  | # eliminate irrelevant exclusions
794 |  |  |  |  | if ($self->{exclusions}) {
795 |  |  |  |  | my %seen;
796 |  |  |  |  | @{ $self->{exclusions} } = grep {
797 |  |  |  |  | (! defined $self->{minimum} or $_ >= $self->{minimum})
798 |  |  |  |  | and
799 |  |  |  |  | (! defined $self->{maximum} or $_ <= $self->{maximum})
800 |  |  |  |  | and
801 |  |  |  |  | ! $seen{$_}++
802 |  |  |  |  | } @{ $self->{exclusions} };
803 |  |  |  |  | }
804 |  |  |  |  |
805 |  |  |  |  | return $self;
806 |  |  |  |  | }
807 |  |  |  |  |
808 |  |  |  |  | sub with_minimum {
809 |  |  |  |  | my ($self, $minimum, $module) = @_;
810 |  |  |  |  | $module = 'module' unless defined $module;
811 |  |  |  |  | $self = $self->_clone;
812 |  |  |  |  |
813 |  |  |  |  | if (defined (my $old_min = $self->{minimum})) {
814 |  |  |  |  | $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0];
815 |  |  |  |  | } else {
816 |  |  |  |  | $self->{minimum} = $minimum;
817 |  |  |  |  | }
818 |  |  |  |  |
819 |  |  |  |  | return $self->_simplify($module);
820 |  |  |  |  | }
821 |  |  |  |  |
822 |  |  |  |  | sub with_maximum {
823 |  |  |  |  | my ($self, $maximum, $module) = @_;
824 |  |  |  |  | $module = 'module' unless defined $module;
825 |  |  |  |  | $self = $self->_clone;
826 |  |  |  |  |
827 |  |  |  |  | if (defined (my $old_max = $self->{maximum})) {
828 |  |  |  |  | $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0];
829 |  |  |  |  | } else {
830 |  |  |  |  | $self->{maximum} = $maximum;
831 |  |  |  |  | }
832 |  |  |  |  |
833 |  |  |  |  | return $self->_simplify($module);
834 |  |  |  |  | }
835 |  |  |  |  |
836 |  |  |  |  | sub with_exclusion {
837 |  |  |  |  | my ($self, $exclusion, $module) = @_;
838 |  |  |  |  | $module = 'module' unless defined $module;
839 |  |  |  |  | $self = $self->_clone;
840 |  |  |  |  |
841 |  |  |  |  | push @{ $self->{exclusions} ||= [] }, $exclusion;
842 |  |  |  |  |
843 |  |  |  |  | return $self->_simplify($module);
844 |  |  |  |  | }
845 |  |  |  |  |
846 |  |  |  |  | sub _accepts {
847 |  |  |  |  | my ($self, $version) = @_;
848 |  |  |  |  |
849 |  |  |  |  | return if defined $self->{minimum} and $version < $self->{minimum};
850 |  |  |  |  | return if defined $self->{maximum} and $version > $self->{maximum};
851 |  |  |  |  | return if defined $self->{exclusions}
852 |  |  |  |  | and grep { $version == $_ } @{ $self->{exclusions} };
853 |  |  |  |  |
854 |  |  |  |  | return 1;
855 |  |  |  |  | }
856 |  |  |  |  | }
857 |  |  |  |  |
858 | 2 | 5µs |  |  | 1;
859 |  |  |  |  | # vim: ts=2 sts=2 sw=2 et:
860 |  |  |  |  |
861 |  |  |  |  | __END__
|  |  |  |  | # spent 200ns within CPAN::Meta::Prereqs::__ANON__ which was called: # once (200ns+0s) by CPAN::Meta::Prereqs::BEGIN@18 at line 18 of CPAN/Meta/Prereqs.pm sub CPAN::Meta::Prereqs::__ANON__; # xsub