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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 17µs | 20µs | BEGIN@44 | CPAN::Meta::Requirements::
1 | 1 | 1 | 11µs | 11µs | BEGIN@214 | CPAN::Meta::Requirements::
1 | 1 | 1 | 6µs | 6µs | BEGIN@1 | CPAN::Meta::Prereqs::
1 | 1 | 1 | 4µs | 13µs | BEGIN@229 | CPAN::Meta::Requirements::
1 | 1 | 1 | 3µs | 10µs | BEGIN@3 | CPAN::Meta::Prereqs::
1 | 1 | 1 | 2µs | 4µs | BEGIN@2 | CPAN::Meta::Prereqs::
1 | 1 | 1 | 1µs | 1µs | BEGIN@36 | CPAN::Meta::Requirements::
1 | 1 | 1 | 200ns | 200ns | __ANON__ (xsub) | CPAN::Meta::Prereqs::
0 | 0 | 0 | 0s | 0s | _accepts | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | _clone | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | _new | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | _reject_requirements | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | as_modifiers | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | as_string | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | as_struct | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | with_exact_version | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | with_exclusion | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | with_maximum | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | with_minimum | CPAN::Meta::Requirements::_Range::Exact::
0 | 0 | 0 | 0s | 0s | _accepts | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | _clone | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | _reject_requirements | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | _self | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | _simplify | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | as_modifiers | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | as_string | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | as_struct | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | with_exact_version | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | with_exclusion | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | with_maximum | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | with_minimum | CPAN::Meta::Requirements::_Range::Range::
0 | 0 | 0 | 0s | 0s | __ANON__[:133] | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | __ANON__[:227] | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | __ANON__[:52] | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | __entry_for | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | __modify_entry_for | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | _blank_carp | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | _find_magic_vstring | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | _isa_version | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | _version_object | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | accepts_module | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | add_minimum | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | add_requirements | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | add_string_requirement | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | as_string_hash | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | clear_requirement | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | clone | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | finalize | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | from_string_hash | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | is_finalized | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | is_simple | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | new | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | required_modules | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | requirements_for_module | CPAN::Meta::Requirements::
0 | 0 | 0 | 0s | 0s | structured_requirements_for_module | CPAN::Meta::Requirements::
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 # 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 # 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 # 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 # 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 | ||||
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 | ||||
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 # 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 |