File Coverage

blib/lib/CPAN/Meta/Requirements.pm
Criterion Covered Total %
statement 92 92 100.0
branch 22 26 84.6
condition 12 13 92.3
subroutine 26 26 100.0
pod 16 16 100.0
total 168 173 97.1


line stmt bran cond sub pod time code
1 9     9   74240 use v5.10;
  9         82  
2 9     9   87 use strict;
  9         21  
  9         267  
3 9     9   47 use warnings;
  9         25  
  9         548  
4             package CPAN::Meta::Requirements;
5             # ABSTRACT: a set of version requirements for a CPAN dist
6              
7             our $VERSION = '2.142';
8              
9 9     9   4608 use CPAN::Meta::Requirements::Range;
  9         25  
  9         303  
10              
11             #pod =head1 SYNOPSIS
12             #pod
13             #pod use CPAN::Meta::Requirements;
14             #pod
15             #pod my $build_requires = CPAN::Meta::Requirements->new;
16             #pod
17             #pod $build_requires->add_minimum('Library::Foo' => 1.208);
18             #pod
19             #pod $build_requires->add_minimum('Library::Foo' => 2.602);
20             #pod
21             #pod $build_requires->add_minimum('Module::Bar' => 'v1.2.3');
22             #pod
23             #pod $METAyml->{build_requires} = $build_requires->as_string_hash;
24             #pod
25             #pod =head1 DESCRIPTION
26             #pod
27             #pod A CPAN::Meta::Requirements object models a set of version constraints like
28             #pod those specified in the F or F files in CPAN distributions,
29             #pod and as defined by L.
30             #pod It can be built up by adding more and more constraints, and it will reduce them
31             #pod to the simplest representation.
32             #pod
33             #pod Logically impossible constraints will be identified immediately by thrown
34             #pod exceptions.
35             #pod
36             #pod =cut
37              
38 9     9   70 use Carp ();
  9         29  
  9         1756  
39              
40             #pod =method new
41             #pod
42             #pod my $req = CPAN::Meta::Requirements->new;
43             #pod
44             #pod This returns a new CPAN::Meta::Requirements object. It takes an optional
45             #pod hash reference argument. Currently, only one key is supported:
46             #pod
47             #pod =for :list
48             #pod * C -- if provided, when a version cannot be parsed into
49             #pod a version object, this code reference will be called with the invalid
50             #pod version string as first argument, and the module name as second
51             #pod argument. It must return a valid version object.
52             #pod
53             #pod All other keys are ignored.
54             #pod
55             #pod =cut
56              
57             my @valid_options = qw( bad_version_hook );
58              
59             sub new {
60 90     90 1 81394 my ($class, $options) = @_;
61 90   100     413 $options ||= {};
62 90 50       255 Carp::croak "Argument to $class\->new() must be a hash reference"
63             unless ref $options eq 'HASH';
64 90         235 my %self = map {; $_ => $options->{$_}} @valid_options;
  90         340  
65              
66 90         314 return bless \%self => $class;
67             }
68              
69             #pod =method add_minimum
70             #pod
71             #pod $req->add_minimum( $module => $version );
72             #pod
73             #pod This adds a new minimum version requirement. If the new requirement is
74             #pod redundant to the existing specification, this has no effect.
75             #pod
76             #pod Minimum requirements are inclusive. C<$version> is required, along with any
77             #pod greater version number.
78             #pod
79             #pod This method returns the requirements object.
80             #pod
81             #pod =method add_maximum
82             #pod
83             #pod $req->add_maximum( $module => $version );
84             #pod
85             #pod This adds a new maximum version requirement. If the new requirement is
86             #pod redundant to the existing specification, this has no effect.
87             #pod
88             #pod Maximum requirements are inclusive. No version strictly greater than the given
89             #pod version is allowed.
90             #pod
91             #pod This method returns the requirements object.
92             #pod
93             #pod =method add_exclusion
94             #pod
95             #pod $req->add_exclusion( $module => $version );
96             #pod
97             #pod This adds a new excluded version. For example, you might use these three
98             #pod method calls:
99             #pod
100             #pod $req->add_minimum( $module => '1.00' );
101             #pod $req->add_maximum( $module => '1.82' );
102             #pod
103             #pod $req->add_exclusion( $module => '1.75' );
104             #pod
105             #pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for
106             #pod 1.75.
107             #pod
108             #pod This method returns the requirements object.
109             #pod
110             #pod =method exact_version
111             #pod
112             #pod $req->exact_version( $module => $version );
113             #pod
114             #pod This sets the version required for the given module to I the given
115             #pod version. No other version would be considered acceptable.
116             #pod
117             #pod This method returns the requirements object.
118             #pod
119             #pod =cut
120              
121             BEGIN {
122 9     9   39 for my $type (qw(maximum exclusion exact_version)) {
123 27         76 my $method = "with_$type";
124 27 100       82 my $to_add = $type eq 'exact_version' ? $type : "add_$type";
125              
126             my $code = sub {
127 41     41   246 my ($self, $name, $version) = @_;
128              
129 41         102 $self->__modify_entry_for($name, $method, $version);
130              
131 35         104 return $self;
132 27         200 };
133              
134 9     9   65 no strict 'refs';
  9         18  
  9         426  
135 27         9368 *$to_add = $code;
136             }
137             }
138              
139             # add_minimum is optimized compared to generated subs above because
140             # it is called frequently and with "0" or equivalent input
141             sub add_minimum {
142 46     46 1 2584 my ($self, $name, $version) = @_;
143              
144             # stringify $version so that version->new("0.00")->stringify ne "0"
145             # which preserves the user's choice of "0.00" as the requirement
146 46 100 100     212 if (not defined $version or "$version" eq '0') {
147 9 100       26 return $self if $self->__entry_for($name);
148 5 100       14 Carp::croak("can't add new requirements to finalized requirements")
149             if $self->is_finalized;
150              
151 4         18 $self->{requirements}{ $name } =
152             CPAN::Meta::Requirements::Range->with_minimum('0', $name);
153             }
154             else {
155 37         99 $self->__modify_entry_for($name, 'with_minimum', $version);
156             }
157 37         95 return $self;
158             }
159              
160             #pod =method version_range_for_module
161             #pod
162             #pod $req->version_range_for_module( $another_req_object );
163             #pod
164             #pod =cut
165              
166             sub version_range_for_module {
167 266     266 1 486 my ($self, $module) = @_;
168 266         618 return $self->{requirements}{$module};
169             }
170              
171             #pod =method add_requirements
172             #pod
173             #pod $req->add_requirements( $another_req_object );
174             #pod
175             #pod This method adds all the requirements in the given CPAN::Meta::Requirements
176             #pod object to the requirements object on which it was called. If there are any
177             #pod conflicts, an exception is thrown.
178             #pod
179             #pod This method returns the requirements object.
180             #pod
181             #pod =cut
182              
183             sub add_requirements {
184 23     23 1 92 my ($self, $req) = @_;
185              
186 23         52 for my $module ($req->required_modules) {
187 266         515 my $new_range = $req->version_range_for_module($module);
188 266         511 $self->__modify_entry_for($module, 'with_range', $new_range);
189             }
190              
191 23         65 return $self;
192             }
193              
194             #pod =method accepts_module
195             #pod
196             #pod my $bool = $req->accepts_module($module => $version);
197             #pod
198             #pod Given an module and version, this method returns true if the version
199             #pod specification for the module accepts the provided version. In other words,
200             #pod given:
201             #pod
202             #pod Module => '>= 1.00, < 2.00'
203             #pod
204             #pod We will accept 1.00 and 1.75 but not 0.50 or 2.00.
205             #pod
206             #pod For modules that do not appear in the requirements, this method will return
207             #pod true.
208             #pod
209             #pod =cut
210              
211             sub accepts_module {
212 43     43 1 8798 my ($self, $module, $version) = @_;
213              
214 43 50       94 return 1 unless my $range = $self->__entry_for($module);
215 43         129 return $range->accepts($version);
216             }
217              
218             #pod =method clear_requirement
219             #pod
220             #pod $req->clear_requirement( $module );
221             #pod
222             #pod This removes the requirement for a given module from the object.
223             #pod
224             #pod This method returns the requirements object.
225             #pod
226             #pod =cut
227              
228             sub clear_requirement {
229 3     3 1 11 my ($self, $module) = @_;
230              
231 3 100       9 return $self unless $self->__entry_for($module);
232              
233 2 100       8 Carp::croak("can't clear requirements on finalized requirements")
234             if $self->is_finalized;
235              
236 1         5 delete $self->{requirements}{ $module };
237              
238 1         2 return $self;
239             }
240              
241             #pod =method requirements_for_module
242             #pod
243             #pod $req->requirements_for_module( $module );
244             #pod
245             #pod This returns a string containing the version requirements for a given module in
246             #pod the format described in L or undef if the given module has no
247             #pod requirements. This should only be used for informational purposes such as error
248             #pod messages and should not be interpreted or used for comparison (see
249             #pod L instead).
250             #pod
251             #pod =cut
252              
253             sub requirements_for_module {
254 6     6 1 27 my ($self, $module) = @_;
255 6         14 my $entry = $self->__entry_for($module);
256 6 100       17 return unless $entry;
257 4         11 return $entry->as_string;
258             }
259              
260             #pod =method structured_requirements_for_module
261             #pod
262             #pod $req->structured_requirements_for_module( $module );
263             #pod
264             #pod This returns a data structure containing the version requirements for a given
265             #pod module or undef if the given module has no requirements. This should
266             #pod not be used for version checks (see L instead).
267             #pod
268             #pod Added in version 2.134.
269             #pod
270             #pod =cut
271              
272             sub structured_requirements_for_module {
273 2     2 1 5 my ($self, $module) = @_;
274 2         6 my $entry = $self->__entry_for($module);
275 2 50       7 return unless $entry;
276 2         7 return $entry->as_struct;
277             }
278              
279             #pod =method required_modules
280             #pod
281             #pod This method returns a list of all the modules for which requirements have been
282             #pod specified.
283             #pod
284             #pod =cut
285              
286 114     114 1 1262 sub required_modules { keys %{ $_[0]{requirements} } }
  114         500  
287              
288             #pod =method clone
289             #pod
290             #pod $req->clone;
291             #pod
292             #pod This method returns a clone of the invocant. The clone and the original object
293             #pod can then be changed independent of one another.
294             #pod
295             #pod =cut
296              
297             sub clone {
298 3     3 1 17 my ($self) = @_;
299 3         10 my $new = (ref $self)->new;
300              
301 3         8 return $new->add_requirements($self);
302             }
303              
304 849     849   1619 sub __entry_for { $_[0]{requirements}{ $_[1] } }
305              
306             sub __modify_entry_for {
307 782     782   1395 my ($self, $name, $method, $version) = @_;
308              
309 782         1300 my $fin = $self->is_finalized;
310 782         1476 my $old = $self->__entry_for($name);
311              
312 782 50 66     1637 Carp::croak("can't add new requirements to finalized requirements")
313             if $fin and not $old;
314              
315             my $new = ($old || 'CPAN::Meta::Requirements::Range')
316 782   100     3076 ->$method($version, $name, $self->{bad_version_hook});
317              
318 771 100 100     1983 Carp::croak("can't modify finalized requirements")
319             if $fin and $old->as_string ne $new->as_string;
320              
321 770         2465 $self->{requirements}{ $name } = $new;
322             }
323              
324             #pod =method is_simple
325             #pod
326             #pod This method returns true if and only if all requirements are inclusive minimums
327             #pod -- that is, if their string expression is just the version number.
328             #pod
329             #pod =cut
330              
331             sub is_simple {
332 2     2 1 5 my ($self) = @_;
333 2         5 for my $module ($self->required_modules) {
334             # XXX: This is a complete hack, but also entirely correct.
335 4 100       10 return if not $self->__entry_for($module)->is_simple;
336             }
337              
338 1         3 return 1;
339             }
340              
341             #pod =method is_finalized
342             #pod
343             #pod This method returns true if the requirements have been finalized by having the
344             #pod C method called on them.
345             #pod
346             #pod =cut
347              
348 789     789 1 1484 sub is_finalized { $_[0]{finalized} }
349              
350             #pod =method finalize
351             #pod
352             #pod This method marks the requirements finalized. Subsequent attempts to change
353             #pod the requirements will be fatal, I they would result in a change. If they
354             #pod would not alter the requirements, they have no effect.
355             #pod
356             #pod If a finalized set of requirements is cloned, the cloned requirements are not
357             #pod also finalized.
358             #pod
359             #pod =cut
360              
361 1     1 1 4 sub finalize { $_[0]{finalized} = 1 }
362              
363             #pod =method as_string_hash
364             #pod
365             #pod This returns a reference to a hash describing the requirements using the
366             #pod strings in the L specification.
367             #pod
368             #pod For example after the following program:
369             #pod
370             #pod my $req = CPAN::Meta::Requirements->new;
371             #pod
372             #pod $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
373             #pod
374             #pod $req->add_minimum('Library::Foo' => 1.208);
375             #pod
376             #pod $req->add_maximum('Library::Foo' => 2.602);
377             #pod
378             #pod $req->add_minimum('Module::Bar' => 'v1.2.3');
379             #pod
380             #pod $req->add_exclusion('Module::Bar' => 'v1.2.8');
381             #pod
382             #pod $req->exact_version('Xyzzy' => '6.01');
383             #pod
384             #pod my $hashref = $req->as_string_hash;
385             #pod
386             #pod C<$hashref> would contain:
387             #pod
388             #pod {
389             #pod 'CPAN::Meta::Requirements' => '0.102',
390             #pod 'Library::Foo' => '>= 1.208, <= 2.206',
391             #pod 'Module::Bar' => '>= v1.2.3, != v1.2.8',
392             #pod 'Xyzzy' => '== 6.01',
393             #pod }
394             #pod
395             #pod =cut
396              
397             sub as_string_hash {
398 50     50 1 1862 my ($self) = @_;
399              
400 50         103 my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
  391         977  
401             $self->required_modules;
402              
403 50         367 return \%hash;
404             }
405              
406             #pod =method add_string_requirement
407             #pod
408             #pod $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
409             #pod $req->add_string_requirement('Library::Foo' => v1.208);
410             #pod
411             #pod This method parses the passed in string and adds the appropriate requirement
412             #pod for the given module. A version can be a Perl "v-string". It understands
413             #pod version ranges as described in the L. For
414             #pod example:
415             #pod
416             #pod =over 4
417             #pod
418             #pod =item 1.3
419             #pod
420             #pod =item >= 1.3
421             #pod
422             #pod =item <= 1.3
423             #pod
424             #pod =item == 1.3
425             #pod
426             #pod =item != 1.3
427             #pod
428             #pod =item > 1.3
429             #pod
430             #pod =item < 1.3
431             #pod
432             #pod =item >= 1.3, != 1.5, <= 2.0
433             #pod
434             #pod A version number without an operator is equivalent to specifying a minimum
435             #pod (C=>). Extra whitespace is allowed.
436             #pod
437             #pod =back
438             #pod
439             #pod =cut
440              
441             sub add_string_requirement {
442 438     438 1 3448 my ($self, $module, $req) = @_;
443              
444 438         808 $self->__modify_entry_for($module, 'with_string_requirement', $req);
445             }
446              
447             #pod =method from_string_hash
448             #pod
449             #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
450             #pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts );
451             #pod
452             #pod This is an alternate constructor for a CPAN::Meta::Requirements
453             #pod object. It takes a hash of module names and version requirement
454             #pod strings and returns a new CPAN::Meta::Requirements object. As with
455             #pod add_string_requirement, a version can be a Perl "v-string". Optionally,
456             #pod you can supply a hash-reference of options, exactly as with the L
457             #pod method.
458             #pod
459             #pod =cut
460              
461             sub from_string_hash {
462 27     27 1 30498 my ($class, $hash, $options) = @_;
463              
464 27         63 my $self = $class->new($options);
465              
466 27         119 for my $module (keys %$hash) {
467 346         570 my $req = $hash->{$module};
468 346         611 $self->add_string_requirement($module, $req);
469             }
470              
471 26         103 return $self;
472             }
473              
474             1;
475             # vim: ts=2 sts=2 sw=2 et:
476              
477             __END__