1use 5.006;
2use strict;
3use warnings;
4package CPAN::Meta::Prereqs;
5our $VERSION = '2.140640'; # VERSION
6
7# =head1 DESCRIPTION
8#
9# A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
10# distribution or one of its optional features.  Each set of prereqs is
11# organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
12#
13# =cut
14
15use Carp qw(confess);
16use Scalar::Util qw(blessed);
17use CPAN::Meta::Requirements 2.121;
18
19# =method new
20#
21#   my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
22#
23# This method returns a new set of Prereqs.  The input should look like the
24# contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
25# something more or less like this:
26#
27#   my $prereq = CPAN::Meta::Prereqs->new({
28#     runtime => {
29#       requires => {
30#         'Some::Module' => '1.234',
31#         ...,
32#       },
33#       ...,
34#     },
35#     ...,
36#   });
37#
38# You can also construct an empty set of prereqs with:
39#
40#   my $prereqs = CPAN::Meta::Prereqs->new;
41#
42# This empty set of prereqs is useful for accumulating new prereqs before finally
43# dumping the whole set into a structure or string.
44#
45# =cut
46
47sub __legal_phases { qw(configure build test runtime develop)   }
48sub __legal_types  { qw(requires recommends suggests conflicts) }
49
50# expect a prereq spec from META.json -- rjbs, 2010-04-11
51sub new {
52  my ($class, $prereq_spec) = @_;
53  $prereq_spec ||= {};
54
55  my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases;
56  my %is_legal_type  = map {; $_ => 1 } $class->__legal_types;
57
58  my %guts;
59  PHASE: for my $phase (keys %$prereq_spec) {
60    next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase};
61
62    my $phase_spec = $prereq_spec->{ $phase };
63    next PHASE unless keys %$phase_spec;
64
65    TYPE: for my $type (keys %$phase_spec) {
66      next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type};
67
68      my $spec = $phase_spec->{ $type };
69
70      next TYPE unless keys %$spec;
71
72      $guts{prereqs}{$phase}{$type} = CPAN::Meta::Requirements->from_string_hash(
73        $spec
74      );
75    }
76  }
77
78  return bless \%guts => $class;
79}
80
81# =method requirements_for
82#
83#   my $requirements = $prereqs->requirements_for( $phase, $type );
84#
85# This method returns a L<CPAN::Meta::Requirements> object for the given
86# phase/type combination.  If no prerequisites are registered for that
87# combination, a new CPAN::Meta::Requirements object will be returned, and it may
88# be added to as needed.
89#
90# If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
91# be raised.
92#
93# =cut
94
95sub requirements_for {
96  my ($self, $phase, $type) = @_;
97
98  confess "requirements_for called without phase" unless defined $phase;
99  confess "requirements_for called without type"  unless defined $type;
100
101  unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
102    confess "requested requirements for unknown phase: $phase";
103  }
104
105  unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
106    confess "requested requirements for unknown type: $type";
107  }
108
109  my $req = ($self->{prereqs}{$phase}{$type} ||= CPAN::Meta::Requirements->new);
110
111  $req->finalize if $self->is_finalized;
112
113  return $req;
114}
115
116# =method with_merged_prereqs
117#
118#   my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
119#
120#   my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
121#
122# This method returns a new CPAN::Meta::Prereqs objects in which all the
123# other prerequisites given are merged into the current set.  This is primarily
124# provided for combining a distribution's core prereqs with the prereqs of one of
125# its optional features.
126#
127# The new prereqs object has no ties to the originals, and altering it further
128# will not alter them.
129#
130# =cut
131
132sub with_merged_prereqs {
133  my ($self, $other) = @_;
134
135  my @other = blessed($other) ? $other : @$other;
136
137  my @prereq_objs = ($self, @other);
138
139  my %new_arg;
140
141  for my $phase ($self->__legal_phases) {
142    for my $type ($self->__legal_types) {
143      my $req = CPAN::Meta::Requirements->new;
144
145      for my $prereq (@prereq_objs) {
146        my $this_req = $prereq->requirements_for($phase, $type);
147        next unless $this_req->required_modules;
148
149        $req->add_requirements($this_req);
150      }
151
152      next unless $req->required_modules;
153
154      $new_arg{ $phase }{ $type } = $req->as_string_hash;
155    }
156  }
157
158  return (ref $self)->new(\%new_arg);
159}
160
161# =method merged_requirements
162#
163#     my $new_reqs = $prereqs->merged_requirements( \@phases, \@types );
164#     my $new_reqs = $prereqs->merged_requirements( \@phases );
165#     my $new_reqs = $preerqs->merged_requirements();
166#
167# This method joins together all requirements across a number of phases
168# and types into a new L<CPAN::Meta::Requirements> object.  If arguments
169# are omitted, it defaults to "runtime", "build" and "test" for phases
170# and "requires" and "recommends" for types.
171#
172# =cut
173
174sub merged_requirements {
175  my ($self, $phases, $types) = @_;
176  $phases = [qw/runtime build test/] unless defined $phases;
177  $types = [qw/requires recommends/] unless defined $types;
178
179  confess "merged_requirements phases argument must be an arrayref"
180    unless ref $phases eq 'ARRAY';
181  confess "merged_requirements types argument must be an arrayref"
182    unless ref $types eq 'ARRAY';
183
184  my $req = CPAN::Meta::Requirements->new;
185
186  for my $phase ( @$phases ) {
187    unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
188        confess "requested requirements for unknown phase: $phase";
189    }
190    for my $type ( @$types ) {
191      unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
192          confess "requested requirements for unknown type: $type";
193      }
194      $req->add_requirements( $self->requirements_for($phase, $type) );
195    }
196  }
197
198  $req->finalize if $self->is_finalized;
199
200  return $req;
201}
202
203
204# =method as_string_hash
205#
206# This method returns a hashref containing structures suitable for dumping into a
207# distmeta data structure.  It is made up of hashes and strings, only; there will
208# be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
209#
210# =cut
211
212sub as_string_hash {
213  my ($self) = @_;
214
215  my %hash;
216
217  for my $phase ($self->__legal_phases) {
218    for my $type ($self->__legal_types) {
219      my $req = $self->requirements_for($phase, $type);
220      next unless $req->required_modules;
221
222      $hash{ $phase }{ $type } = $req->as_string_hash;
223    }
224  }
225
226  return \%hash;
227}
228
229# =method is_finalized
230#
231# This method returns true if the set of prereqs has been marked "finalized," and
232# cannot be altered.
233#
234# =cut
235
236sub is_finalized { $_[0]{finalized} }
237
238# =method finalize
239#
240# Calling C<finalize> on a Prereqs object will close it for further modification.
241# Attempting to make any changes that would actually alter the prereqs will
242# result in an exception being thrown.
243#
244# =cut
245
246sub finalize {
247  my ($self) = @_;
248
249  $self->{finalized} = 1;
250
251  for my $phase (keys %{ $self->{prereqs} }) {
252    $_->finalize for values %{ $self->{prereqs}{$phase} };
253  }
254}
255
256# =method clone
257#
258#   my $cloned_prereqs = $prereqs->clone;
259#
260# This method returns a Prereqs object that is identical to the original object,
261# but can be altered without affecting the original object.  Finalization does
262# not survive cloning, meaning that you may clone a finalized set of prereqs and
263# then modify the clone.
264#
265# =cut
266
267sub clone {
268  my ($self) = @_;
269
270  my $clone = (ref $self)->new( $self->as_string_hash );
271}
272
2731;
274
275# ABSTRACT: a set of distribution prerequisites by phase and type
276
277__END__
278
279=pod
280
281=encoding UTF-8
282
283=head1 NAME
284
285CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
286
287=head1 VERSION
288
289version 2.140640
290
291=head1 DESCRIPTION
292
293A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
294distribution or one of its optional features.  Each set of prereqs is
295organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
296
297=head1 METHODS
298
299=head2 new
300
301  my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
302
303This method returns a new set of Prereqs.  The input should look like the
304contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
305something more or less like this:
306
307  my $prereq = CPAN::Meta::Prereqs->new({
308    runtime => {
309      requires => {
310        'Some::Module' => '1.234',
311        ...,
312      },
313      ...,
314    },
315    ...,
316  });
317
318You can also construct an empty set of prereqs with:
319
320  my $prereqs = CPAN::Meta::Prereqs->new;
321
322This empty set of prereqs is useful for accumulating new prereqs before finally
323dumping the whole set into a structure or string.
324
325=head2 requirements_for
326
327  my $requirements = $prereqs->requirements_for( $phase, $type );
328
329This method returns a L<CPAN::Meta::Requirements> object for the given
330phase/type combination.  If no prerequisites are registered for that
331combination, a new CPAN::Meta::Requirements object will be returned, and it may
332be added to as needed.
333
334If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
335be raised.
336
337=head2 with_merged_prereqs
338
339  my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
340
341  my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
342
343This method returns a new CPAN::Meta::Prereqs objects in which all the
344other prerequisites given are merged into the current set.  This is primarily
345provided for combining a distribution's core prereqs with the prereqs of one of
346its optional features.
347
348The new prereqs object has no ties to the originals, and altering it further
349will not alter them.
350
351=head2 merged_requirements
352
353    my $new_reqs = $prereqs->merged_requirements( \@phases, \@types );
354    my $new_reqs = $prereqs->merged_requirements( \@phases );
355    my $new_reqs = $preerqs->merged_requirements();
356
357This method joins together all requirements across a number of phases
358and types into a new L<CPAN::Meta::Requirements> object.  If arguments
359are omitted, it defaults to "runtime", "build" and "test" for phases
360and "requires" and "recommends" for types.
361
362=head2 as_string_hash
363
364This method returns a hashref containing structures suitable for dumping into a
365distmeta data structure.  It is made up of hashes and strings, only; there will
366be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
367
368=head2 is_finalized
369
370This method returns true if the set of prereqs has been marked "finalized," and
371cannot be altered.
372
373=head2 finalize
374
375Calling C<finalize> on a Prereqs object will close it for further modification.
376Attempting to make any changes that would actually alter the prereqs will
377result in an exception being thrown.
378
379=head2 clone
380
381  my $cloned_prereqs = $prereqs->clone;
382
383This method returns a Prereqs object that is identical to the original object,
384but can be altered without affecting the original object.  Finalization does
385not survive cloning, meaning that you may clone a finalized set of prereqs and
386then modify the clone.
387
388=head1 BUGS
389
390Please report any bugs or feature using the CPAN Request Tracker.
391Bugs can be submitted through the web interface at
392L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
393
394When submitting a bug or request, please include a test-file or a patch to an
395existing test-file that illustrates the bug or desired feature.
396
397=head1 AUTHORS
398
399=over 4
400
401=item *
402
403David Golden <dagolden@cpan.org>
404
405=item *
406
407Ricardo Signes <rjbs@cpan.org>
408
409=back
410
411=head1 COPYRIGHT AND LICENSE
412
413This software is copyright (c) 2010 by David Golden and Ricardo Signes.
414
415This is free software; you can redistribute it and/or modify it under
416the same terms as the Perl 5 programming language system itself.
417
418=cut
419