This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
36f26d80a7594ab5a7c0dc84a8568358f0079931
[perl5.git] / cpan / CPAN-Meta / lib / CPAN / Meta.pm
1 use 5.006;
2 use strict;
3 use warnings;
4 package CPAN::Meta;
5 our $VERSION = '2.112150'; # VERSION
6
7
8 use Carp qw(carp croak);
9 use CPAN::Meta::Feature;
10 use CPAN::Meta::Prereqs;
11 use CPAN::Meta::Converter;
12 use CPAN::Meta::Validator;
13 use Parse::CPAN::Meta 1.4400 ();
14
15 BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone }
16
17
18 BEGIN {
19   my @STRING_READERS = qw(
20     abstract
21     description
22     dynamic_config
23     generated_by
24     name
25     release_status
26     version
27   );
28
29   no strict 'refs';
30   for my $attr (@STRING_READERS) {
31     *$attr = sub { $_[0]{ $attr } };
32   }
33 }
34
35
36 BEGIN {
37   my @LIST_READERS = qw(
38     author
39     keywords
40     license
41   );
42
43   no strict 'refs';
44   for my $attr (@LIST_READERS) {
45     *$attr = sub {
46       my $value = $_[0]{ $attr };
47       croak "$attr must be called in list context"
48         unless wantarray;
49       return @{ _dclone($value) } if ref $value;
50       return $value;
51     };
52   }
53 }
54
55 sub authors  { $_[0]->author }
56 sub licenses { $_[0]->license }
57
58
59 BEGIN {
60   my @MAP_READERS = qw(
61     meta-spec
62     resources
63     provides
64     no_index
65
66     prereqs
67     optional_features
68   );
69
70   no strict 'refs';
71   for my $attr (@MAP_READERS) {
72     (my $subname = $attr) =~ s/-/_/;
73     *$subname = sub {
74       my $value = $_[0]{ $attr };
75       return _dclone($value) if $value;
76       return {};
77     };
78   }
79 }
80
81
82 sub custom_keys {
83   return grep { /^x_/i } keys %{$_[0]};
84 }
85
86 sub custom {
87   my ($self, $attr) = @_;
88   my $value = $self->{$attr};
89   return _dclone($value) if ref $value;
90   return $value;
91 }
92
93
94 sub _new {
95   my ($class, $struct, $options) = @_;
96   my $self;
97
98   if ( $options->{lazy_validation} ) {
99     # try to convert to a valid structure; if succeeds, then return it
100     my $cmc = CPAN::Meta::Converter->new( $struct );
101     $self = $cmc->convert( version => 2 ); # valid or dies
102     return bless $self, $class;
103   }
104   else {
105     # validate original struct
106     my $cmv = CPAN::Meta::Validator->new( $struct );
107     unless ( $cmv->is_valid) {
108       die "Invalid metadata structure. Errors: "
109         . join(", ", $cmv->errors) . "\n";
110     }
111   }
112
113   # up-convert older spec versions
114   my $version = $struct->{'meta-spec'}{version} || '1.0';
115   if ( $version == 2 ) {
116     $self = $struct;
117   }
118   else {
119     my $cmc = CPAN::Meta::Converter->new( $struct );
120     $self = $cmc->convert( version => 2 );
121   }
122
123   return bless $self, $class;
124 }
125
126 sub new {
127   my ($class, $struct, $options) = @_;
128   my $self = eval { $class->_new($struct, $options) };
129   croak($@) if $@;
130   return $self;
131 }
132
133
134 sub create {
135   my ($class, $struct, $options) = @_;
136   my $version = __PACKAGE__->VERSION || 2;
137   $struct->{generated_by} ||= __PACKAGE__ . " version $version" ;
138   $struct->{'meta-spec'}{version} ||= int($version);
139   my $self = eval { $class->_new($struct, $options) };
140   croak ($@) if $@;
141   return $self;
142 }
143
144
145 sub load_file {
146   my ($class, $file, $options) = @_;
147   $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
148
149   croak "load_file() requires a valid, readable filename"
150     unless -r $file;
151
152   my $self;
153   eval {
154     my $struct = Parse::CPAN::Meta->load_file( $file );
155     $self = $class->_new($struct, $options);
156   };
157   croak($@) if $@;
158   return $self;
159 }
160
161
162 sub load_yaml_string {
163   my ($class, $yaml, $options) = @_;
164   $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
165
166   my $self;
167   eval {
168     my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml );
169     $self = $class->_new($struct, $options);
170   };
171   croak($@) if $@;
172   return $self;
173 }
174
175
176 sub load_json_string {
177   my ($class, $json, $options) = @_;
178   $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
179
180   my $self;
181   eval {
182     my $struct = Parse::CPAN::Meta->load_json_string( $json );
183     $self = $class->_new($struct, $options);
184   };
185   croak($@) if $@;
186   return $self;
187 }
188
189
190 sub save {
191   my ($self, $file, $options) = @_;
192
193   my $version = $options->{version} || '2';
194   my $layer = $] ge '5.008001' ? ':utf8' : '';
195
196   if ( $version ge '2' ) {
197     carp "'$file' should end in '.json'"
198       unless $file =~ m{\.json$};
199   }
200   else {
201     carp "'$file' should end in '.yml'"
202       unless $file =~ m{\.yml$};
203   }
204
205   my $data = $self->as_string( $options );
206   open my $fh, ">$layer", $file
207     or die "Error opening '$file' for writing: $!\n";
208
209   print {$fh} $data;
210   close $fh
211     or die "Error closing '$file': $!\n";
212
213   return 1;
214 }
215
216
217 sub meta_spec_version {
218   my ($self) = @_;
219   return $self->meta_spec->{version};
220 }
221
222
223 sub effective_prereqs {
224   my ($self, $features) = @_;
225   $features ||= [];
226
227   my $prereq = CPAN::Meta::Prereqs->new($self->prereqs);
228
229   return $prereq unless @$features;
230
231   my @other = map {; $self->feature($_)->prereqs } @$features;
232
233   return $prereq->with_merged_prereqs(\@other);
234 }
235
236
237 sub should_index_file {
238   my ($self, $filename) = @_;
239
240   for my $no_index_file (@{ $self->no_index->{file} || [] }) {
241     return if $filename eq $no_index_file;
242   }
243
244   for my $no_index_dir (@{ $self->no_index->{directory} }) {
245     $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z};
246     return if index($filename, $no_index_dir) == 0;
247   }
248
249   return 1;
250 }
251
252
253 sub should_index_package {
254   my ($self, $package) = @_;
255
256   for my $no_index_pkg (@{ $self->no_index->{package} || [] }) {
257     return if $package eq $no_index_pkg;
258   }
259
260   for my $no_index_ns (@{ $self->no_index->{namespace} }) {
261     return if index($package, "${no_index_ns}::") == 0;
262   }
263
264   return 1;
265 }
266
267
268 sub features {
269   my ($self) = @_;
270
271   my $opt_f = $self->optional_features;
272   my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) }
273                  keys %$opt_f;
274
275   return @features;
276 }
277
278
279 sub feature {
280   my ($self, $ident) = @_;
281
282   croak "no feature named $ident"
283     unless my $f = $self->optional_features->{ $ident };
284
285   return CPAN::Meta::Feature->new($ident, $f);
286 }
287
288
289 sub as_struct {
290   my ($self, $options) = @_;
291   my $struct = _dclone($self);
292   if ( $options->{version} ) {
293     my $cmc = CPAN::Meta::Converter->new( $struct );
294     $struct = $cmc->convert( version => $options->{version} );
295   }
296   return $struct;
297 }
298
299
300 sub as_string {
301   my ($self, $options) = @_;
302
303   my $version = $options->{version} || '2';
304
305   my $struct;
306   if ( $self->meta_spec_version ne $version ) {
307     my $cmc = CPAN::Meta::Converter->new( $self->as_struct );
308     $struct = $cmc->convert( version => $version );
309   }
310   else {
311     $struct = $self->as_struct;
312   }
313
314   my ($data, $backend);
315   if ( $version ge '2' ) {
316     $backend = Parse::CPAN::Meta->json_backend();
317     $data = $backend->new->pretty->canonical->encode($struct);
318   }
319   else {
320     $backend = Parse::CPAN::Meta->yaml_backend();
321     $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
322     if ( $@ ) {
323       croak $backend->can('errstr') ? $backend->errstr : $@
324     }
325   }
326
327   return $data;
328 }
329
330 # Used by JSON::PP, etc. for "convert_blessed"
331 sub TO_JSON {
332   return { %{ $_[0] } };
333 }
334
335 1;
336
337 # ABSTRACT: the distribution metadata for a CPAN dist
338
339
340
341 =pod
342
343 =head1 NAME
344
345 CPAN::Meta - the distribution metadata for a CPAN dist
346
347 =head1 VERSION
348
349 version 2.112150
350
351 =head1 SYNOPSIS
352
353   my $meta = CPAN::Meta->load_file('META.json');
354
355   printf "testing requirements for %s version %s\n",
356     $meta->name,
357     $meta->version;
358
359   my $prereqs = $meta->requirements_for('configure');
360
361   for my $module ($prereqs->required_modules) {
362     my $version = get_local_version($module);
363
364     die "missing required module $module" unless defined $version;
365     die "version for $module not in range"
366       unless $prereqs->accepts_module($module, $version);
367   }
368
369 =head1 DESCRIPTION
370
371 Software distributions released to the CPAN include a F<META.json> or, for
372 older distributions, F<META.yml>, which describes the distribution, its
373 contents, and the requirements for building and installing the distribution.
374 The data structure stored in the F<META.json> file is described in
375 L<CPAN::Meta::Spec>.
376
377 CPAN::Meta provides a simple class to represent this distribution metadata (or
378 I<distmeta>), along with some helpful methods for interrogating that data.
379
380 The documentation below is only for the methods of the CPAN::Meta object.  For
381 information on the meaning of individual fields, consult the spec.
382
383 =head1 METHODS
384
385 =head2 new
386
387   my $meta = CPAN::Meta->new($distmeta_struct, \%options);
388
389 Returns a valid CPAN::Meta object or dies if the supplied metadata hash
390 reference fails to validate.  Older-format metadata will be up-converted to
391 version 2 if they validate against the original stated specification.
392
393 It takes an optional hashref of options. Valid options include:
394
395 =over
396
397 =item *
398
399 lazy_validation -- if true, new will attempt to convert the given metadata
400 to version 2 before attempting to validate it.  This means than any
401 fixable errors will be handled by CPAN::Meta::Converter before validation.
402 (Note that this might result in invalid optional data being silently
403 dropped.)  The default is false.
404
405 =back
406
407 =head2 create
408
409   my $meta = CPAN::Meta->create($distmeta_struct, \%options);
410
411 This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields
412 will be generated if not provided.  This means the metadata structure is
413 assumed to otherwise follow the latest L<CPAN::Meta::Spec>.
414
415 =head2 load_file
416
417   my $meta = CPAN::Meta->load_file($distmeta_file, \%options);
418
419 Given a pathname to a file containing metadata, this deserializes the file
420 according to its file suffix and constructs a new C<CPAN::Meta> object, just
421 like C<new()>.  It will die if the deserialized version fails to validate
422 against its stated specification version.
423
424 It takes the same options as C<new()> but C<lazy_validation> defaults to
425 true.
426
427 =head2 load_yaml_string
428
429   my $meta = CPAN::Meta->load_yaml_string($yaml, \%options);
430
431 This method returns a new CPAN::Meta object using the first document in the
432 given YAML string.  In other respects it is identical to C<load_file()>.
433
434 =head2 load_json_string
435
436   my $meta = CPAN::Meta->load_json_string($json, \%options);
437
438 This method returns a new CPAN::Meta object using the structure represented by
439 the given JSON string.  In other respects it is identical to C<load_file()>.
440
441 =head2 save
442
443   $meta->save($distmeta_file, \%options);
444
445 Serializes the object as JSON and writes it to the given file.  The only valid
446 option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file
447 is saved with UTF-8 encoding.
448
449 For C<version> 2 (or higher), the filename should end in '.json'.  L<JSON::PP>
450 is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or
451 later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate
452 backend like L<JSON::XS>.
453
454 For C<version> less than 2, the filename should end in '.yml'.
455 L<CPAN::Meta::Converter> is used to generate an older metadata structure, which
456 is serialized to YAML.  CPAN::Meta::YAML is the default YAML backend.  You may
457 set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though
458 this is not recommended due to subtle incompatibilities between YAML parsers on
459 CPAN.
460
461 =head2 meta_spec_version
462
463 This method returns the version part of the C<meta_spec> entry in the distmeta
464 structure.  It is equivalent to:
465
466   $meta->meta_spec->{version};
467
468 =head2 effective_prereqs
469
470   my $prereqs = $meta->effective_prereqs;
471
472   my $prereqs = $meta->effective_prereqs( \@feature_identifiers );
473
474 This method returns a L<CPAN::Meta::Prereqs> object describing all the
475 prereqs for the distribution.  If an arrayref of feature identifiers is given,
476 the prereqs for the identified features are merged together with the
477 distribution's core prereqs before the CPAN::Meta::Prereqs object is returned.
478
479 =head2 should_index_file
480
481   ... if $meta->should_index_file( $filename );
482
483 This method returns true if the given file should be indexed.  It decides this
484 by checking the C<file> and C<directory> keys in the C<no_index> property of
485 the distmeta structure.
486
487 C<$filename> should be given in unix format.
488
489 =head2 should_index_package
490
491   ... if $meta->should_index_package( $package );
492
493 This method returns true if the given package should be indexed.  It decides
494 this by checking the C<package> and C<namespace> keys in the C<no_index>
495 property of the distmeta structure.
496
497 =head2 features
498
499   my @feature_objects = $meta->features;
500
501 This method returns a list of L<CPAN::Meta::Feature> objects, one for each
502 optional feature described by the distribution's metadata.
503
504 =head2 feature
505
506   my $feature_object = $meta->feature( $identifier );
507
508 This method returns a L<CPAN::Meta::Feature> object for the optional feature
509 with the given identifier.  If no feature with that identifier exists, an
510 exception will be raised.
511
512 =head2 as_struct
513
514   my $copy = $meta->as_struct( \%options );
515
516 This method returns a deep copy of the object's metadata as an unblessed has
517 reference.  It takes an optional hashref of options.  If the hashref contains
518 a C<version> argument, the copied metadata will be converted to the version
519 of the specification and returned.  For example:
520
521   my $old_spec = $meta->as_struct( {version => "1.4"} );
522
523 =head2 as_string
524
525   my $string = $meta->as_string( \%options );
526
527 This method returns a serialized copy of the object's metadata as a character
528 string.  (The strings are B<not> UTF-8 encoded.)  It takes an optional hashref
529 of options.  If the hashref contains a C<version> argument, the copied metadata
530 will be converted to the version of the specification and returned.  For
531 example:
532
533   my $string = $meta->as_struct( {version => "1.4"} );
534
535 For C<version> greater than or equal to 2, the string will be serialized as
536 JSON.  For C<version> less than 2, the string will be serialized as YAML.  In
537 both cases, the same rules are followed as in the C<save()> method for choosing
538 a serialization backend.
539
540 =head1 STRING DATA
541
542 The following methods return a single value, which is the value for the
543 corresponding entry in the distmeta structure.  Values should be either undef
544 or strings.
545
546 =over 4
547
548 =item *
549
550 abstract
551
552 =item *
553
554 description
555
556 =item *
557
558 dynamic_config
559
560 =item *
561
562 generated_by
563
564 =item *
565
566 name
567
568 =item *
569
570 release_status
571
572 =item *
573
574 version
575
576 =back
577
578 =head1 LIST DATA
579
580 These methods return lists of string values, which might be represented in the
581 distmeta structure as arrayrefs or scalars:
582
583 =over 4
584
585 =item *
586
587 authors
588
589 =item *
590
591 keywords
592
593 =item *
594
595 licenses
596
597 =back
598
599 The C<authors> and C<licenses> methods may also be called as C<author> and
600 C<license>, respectively, to match the field name in the distmeta structure.
601
602 =head1 MAP DATA
603
604 These readers return hashrefs of arbitrary unblessed data structures, each
605 described more fully in the specification:
606
607 =over 4
608
609 =item *
610
611 meta_spec
612
613 =item *
614
615 resources
616
617 =item *
618
619 provides
620
621 =item *
622
623 no_index
624
625 =item *
626
627 prereqs
628
629 =item *
630
631 optional_features
632
633 =back
634
635 =head1 CUSTOM DATA
636
637 A list of custom keys are available from the C<custom_keys> method and
638 particular keys may be retrieved with the C<custom> method.
639
640   say $meta->custom($_) for $meta->custom_keys;
641
642 If a custom key refers to a data structure, a deep clone is returned.
643
644 =for Pod::Coverage TO_JSON abstract author authors custom custom_keys description dynamic_config
645 generated_by keywords license licenses meta_spec name no_index
646 optional_features prereqs provides release_status resources version
647
648 =head1 BUGS
649
650 Please report any bugs or feature using the CPAN Request Tracker.
651 Bugs can be submitted through the web interface at
652 L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
653
654 When submitting a bug or request, please include a test-file or a patch to an
655 existing test-file that illustrates the bug or desired feature.
656
657 =head1 SEE ALSO
658
659 =over 4
660
661 =item *
662
663 L<CPAN::Meta::Converter>
664
665 =item *
666
667 L<CPAN::Meta::Validator>
668
669 =back
670
671 =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders
672
673 =head1 SUPPORT
674
675 =head2 Bugs / Feature Requests
676
677 Please report any bugs or feature requests by email to C<bug-cpan-meta at rt.cpan.org>, or through
678 the web interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta>. You will be automatically notified of any
679 progress on the request by the system.
680
681 =head2 Source Code
682
683 This is open source software.  The code repository is available for
684 public review and contribution under the terms of the license.
685
686 L<http://github.com/dagolden/cpan-meta>
687
688   git clone git://github.com/dagolden/cpan-meta.git
689
690 =head1 AUTHORS
691
692 =over 4
693
694 =item *
695
696 David Golden <dagolden@cpan.org>
697
698 =item *
699
700 Ricardo Signes <rjbs@cpan.org>
701
702 =back
703
704 =head1 COPYRIGHT AND LICENSE
705
706 This software is copyright (c) 2010 by David Golden and Ricardo Signes.
707
708 This is free software; you can redistribute it and/or modify it under
709 the same terms as the Perl 5 programming language system itself.
710
711 =cut
712
713
714 __END__
715
716