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