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