← 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
StatementsExecuted 33 statements in 1.94ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11117µs20µsCPAN::Meta::Requirements::::BEGIN@44 CPAN::Meta::Requirements::BEGIN@44
11111µs11µsCPAN::Meta::Requirements::::BEGIN@214 CPAN::Meta::Requirements::BEGIN@214
1116µs6µsCPAN::Meta::Prereqs::::BEGIN@1 CPAN::Meta::Prereqs::BEGIN@1
1114µs13µsCPAN::Meta::Requirements::::BEGIN@229 CPAN::Meta::Requirements::BEGIN@229
1113µs10µsCPAN::Meta::Prereqs::::BEGIN@3 CPAN::Meta::Prereqs::BEGIN@3
1112µs4µsCPAN::Meta::Prereqs::::BEGIN@2 CPAN::Meta::Prereqs::BEGIN@2
1111µs1µsCPAN::Meta::Requirements::::BEGIN@36 CPAN::Meta::Requirements::BEGIN@36
111200ns200nsCPAN::Meta::Prereqs::::__ANON__ CPAN::Meta::Prereqs::__ANON__ (xsub)
0000s0sCPAN::Meta::Requirements::_Range::Exact::::_acceptsCPAN::Meta::Requirements::_Range::Exact::_accepts
0000s0sCPAN::Meta::Requirements::_Range::Exact::::_cloneCPAN::Meta::Requirements::_Range::Exact::_clone
0000s0sCPAN::Meta::Requirements::_Range::Exact::::_newCPAN::Meta::Requirements::_Range::Exact::_new
0000s0sCPAN::Meta::Requirements::_Range::Exact::::_reject_requirementsCPAN::Meta::Requirements::_Range::Exact::_reject_requirements
0000s0sCPAN::Meta::Requirements::_Range::Exact::::as_modifiersCPAN::Meta::Requirements::_Range::Exact::as_modifiers
0000s0sCPAN::Meta::Requirements::_Range::Exact::::as_stringCPAN::Meta::Requirements::_Range::Exact::as_string
0000s0sCPAN::Meta::Requirements::_Range::Exact::::as_structCPAN::Meta::Requirements::_Range::Exact::as_struct
0000s0sCPAN::Meta::Requirements::_Range::Exact::::with_exact_versionCPAN::Meta::Requirements::_Range::Exact::with_exact_version
0000s0sCPAN::Meta::Requirements::_Range::Exact::::with_exclusionCPAN::Meta::Requirements::_Range::Exact::with_exclusion
0000s0sCPAN::Meta::Requirements::_Range::Exact::::with_maximumCPAN::Meta::Requirements::_Range::Exact::with_maximum
0000s0sCPAN::Meta::Requirements::_Range::Exact::::with_minimumCPAN::Meta::Requirements::_Range::Exact::with_minimum
0000s0sCPAN::Meta::Requirements::_Range::Range::::_acceptsCPAN::Meta::Requirements::_Range::Range::_accepts
0000s0sCPAN::Meta::Requirements::_Range::Range::::_cloneCPAN::Meta::Requirements::_Range::Range::_clone
0000s0sCPAN::Meta::Requirements::_Range::Range::::_reject_requirementsCPAN::Meta::Requirements::_Range::Range::_reject_requirements
0000s0sCPAN::Meta::Requirements::_Range::Range::::_selfCPAN::Meta::Requirements::_Range::Range::_self
0000s0sCPAN::Meta::Requirements::_Range::Range::::_simplifyCPAN::Meta::Requirements::_Range::Range::_simplify
0000s0sCPAN::Meta::Requirements::_Range::Range::::as_modifiersCPAN::Meta::Requirements::_Range::Range::as_modifiers
0000s0sCPAN::Meta::Requirements::_Range::Range::::as_stringCPAN::Meta::Requirements::_Range::Range::as_string
0000s0sCPAN::Meta::Requirements::_Range::Range::::as_structCPAN::Meta::Requirements::_Range::Range::as_struct
0000s0sCPAN::Meta::Requirements::_Range::Range::::with_exact_versionCPAN::Meta::Requirements::_Range::Range::with_exact_version
0000s0sCPAN::Meta::Requirements::_Range::Range::::with_exclusionCPAN::Meta::Requirements::_Range::Range::with_exclusion
0000s0sCPAN::Meta::Requirements::_Range::Range::::with_maximumCPAN::Meta::Requirements::_Range::Range::with_maximum
0000s0sCPAN::Meta::Requirements::_Range::Range::::with_minimumCPAN::Meta::Requirements::_Range::Range::with_minimum
0000s0sCPAN::Meta::Requirements::::__ANON__[:133] CPAN::Meta::Requirements::__ANON__[:133]
0000s0sCPAN::Meta::Requirements::::__ANON__[:227] CPAN::Meta::Requirements::__ANON__[:227]
0000s0sCPAN::Meta::Requirements::::__ANON__[:52] CPAN::Meta::Requirements::__ANON__[:52]
0000s0sCPAN::Meta::Requirements::::__entry_for CPAN::Meta::Requirements::__entry_for
0000s0sCPAN::Meta::Requirements::::__modify_entry_for CPAN::Meta::Requirements::__modify_entry_for
0000s0sCPAN::Meta::Requirements::::_blank_carp CPAN::Meta::Requirements::_blank_carp
0000s0sCPAN::Meta::Requirements::::_find_magic_vstring CPAN::Meta::Requirements::_find_magic_vstring
0000s0sCPAN::Meta::Requirements::::_isa_version CPAN::Meta::Requirements::_isa_version
0000s0sCPAN::Meta::Requirements::::_version_object CPAN::Meta::Requirements::_version_object
0000s0sCPAN::Meta::Requirements::::accepts_module CPAN::Meta::Requirements::accepts_module
0000s0sCPAN::Meta::Requirements::::add_minimum CPAN::Meta::Requirements::add_minimum
0000s0sCPAN::Meta::Requirements::::add_requirements CPAN::Meta::Requirements::add_requirements
0000s0sCPAN::Meta::Requirements::::add_string_requirement CPAN::Meta::Requirements::add_string_requirement
0000s0sCPAN::Meta::Requirements::::as_string_hash CPAN::Meta::Requirements::as_string_hash
0000s0sCPAN::Meta::Requirements::::clear_requirement CPAN::Meta::Requirements::clear_requirement
0000s0sCPAN::Meta::Requirements::::clone CPAN::Meta::Requirements::clone
0000s0sCPAN::Meta::Requirements::::finalize CPAN::Meta::Requirements::finalize
0000s0sCPAN::Meta::Requirements::::from_string_hash CPAN::Meta::Requirements::from_string_hash
0000s0sCPAN::Meta::Requirements::::is_finalized CPAN::Meta::Requirements::is_finalized
0000s0sCPAN::Meta::Requirements::::is_simple CPAN::Meta::Requirements::is_simple
0000s0sCPAN::Meta::Requirements::::new CPAN::Meta::Requirements::new
0000s0sCPAN::Meta::Requirements::::required_modules CPAN::Meta::Requirements::required_modules
0000s0sCPAN::Meta::Requirements::::requirements_for_module CPAN::Meta::Requirements::requirements_for_module
0000s0sCPAN::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
1219µs16µ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
229µs25µ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
3230µs217µ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
4package CPAN::Meta::Requirements;
5# ABSTRACT: a set of version requirements for a CPAN dist
6
71300nsour $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
36225µs11µ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 {
45113µ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.
4612µs if ( my $err = $@ ) {
47 eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic
48 }
491439µs120µ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
5217µs11µ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
5513µs12µsmy $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
741400nsmy @valid_options = qw( bad_version_hook );
75
76sub 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
87sub _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
107sub _isa_version {
108 UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version')
109}
110
111sub _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 {
21512µs for my $type (qw(maximum exclusion exact_version)) {
2163900ns my $method = "with_$type";
21731µ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;
22734µs };
228
229217µs222µ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
23033µs *$to_add = $code;
231 }
23211.35ms111µ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
236sub 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
269sub 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
300sub 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
319sub 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
344sub 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
363sub 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
377sub 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
388sub clone {
389 my ($self) = @_;
390 my $new = (ref $self)->new;
391
392 return $new->add_requirements($self);
393}
394
395sub __entry_for { $_[0]{requirements}{ $_[1] } }
396
397sub __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
422sub 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
439sub 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
452sub 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
488sub 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
53212µsmy %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
541sub 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
585sub _blank_carp {
586 my ($self, $module) = @_;
587 Carp::carp("Undefined requirement for $module treated as '0'");
588}
589
590sub 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{
6801300ns 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
85825µs1;
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