1use 5.008001;
2use strict;
3use warnings;
4package Parse::CPAN::Meta;
5# ABSTRACT: Parse META.yml and META.json CPAN metadata files
6
7our $VERSION = '2.150010';
8
9use Exporter;
10use Carp 'croak';
11
12our @ISA = qw/Exporter/;
13our @EXPORT_OK = qw/Load LoadFile/;
14
15sub load_file {
16  my ($class, $filename) = @_;
17
18  my $meta = _slurp($filename);
19
20  if ($filename =~ /\.ya?ml$/) {
21    return $class->load_yaml_string($meta);
22  }
23  elsif ($filename =~ /\.json$/) {
24    return $class->load_json_string($meta);
25  }
26  else {
27    $class->load_string($meta); # try to detect yaml/json
28  }
29}
30
31sub load_string {
32  my ($class, $string) = @_;
33  if ( $string =~ /^---/ ) { # looks like YAML
34    return $class->load_yaml_string($string);
35  }
36  elsif ( $string =~ /^\s*\{/ ) { # looks like JSON
37    return $class->load_json_string($string);
38  }
39  else { # maybe doc-marker-free YAML
40    return $class->load_yaml_string($string);
41  }
42}
43
44sub load_yaml_string {
45  my ($class, $string) = @_;
46  my $backend = $class->yaml_backend();
47  my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
48  croak $@ if $@;
49  return $data || {}; # in case document was valid but empty
50}
51
52sub load_json_string {
53  my ($class, $string) = @_;
54  require Encode;
55  # load_json_string takes characters, decode_json expects bytes
56  my $encoded = Encode::encode('UTF-8', $string, Encode::PERLQQ());
57  my $data = eval { $class->json_decoder()->can('decode_json')->($encoded) };
58  croak $@ if $@;
59  return $data || {};
60}
61
62sub yaml_backend {
63  if ($ENV{PERL_CORE} or not defined $ENV{PERL_YAML_BACKEND} ) {
64    _can_load( 'CPAN::Meta::YAML', 0.011 )
65      or croak "CPAN::Meta::YAML 0.011 is not available\n";
66    return "CPAN::Meta::YAML";
67  }
68  else {
69    my $backend = $ENV{PERL_YAML_BACKEND};
70    _can_load( $backend )
71      or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
72    $backend->can("Load")
73      or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
74    return $backend;
75  }
76}
77
78sub json_decoder {
79  if ($ENV{PERL_CORE}) {
80    _can_load( 'JSON::PP' => 2.27300 )
81      or croak "JSON::PP 2.27300 is not available\n";
82    return 'JSON::PP';
83  }
84  if (my $decoder = $ENV{CPAN_META_JSON_DECODER}) {
85    _can_load( $decoder )
86      or croak "Could not load CPAN_META_JSON_DECODER '$decoder'\n";
87    $decoder->can('decode_json')
88      or croak "No decode_json sub provided by CPAN_META_JSON_DECODER '$decoder'\n";
89    return $decoder;
90  }
91  return $_[0]->json_backend;
92}
93
94sub json_backend {
95  if ($ENV{PERL_CORE}) {
96    _can_load( 'JSON::PP' => 2.27300 )
97      or croak "JSON::PP 2.27300 is not available\n";
98    return 'JSON::PP';
99  }
100  if (my $backend = $ENV{CPAN_META_JSON_BACKEND}) {
101    _can_load( $backend )
102      or croak "Could not load CPAN_META_JSON_BACKEND '$backend'\n";
103    $backend->can('new')
104      or croak "No constructor provided by CPAN_META_JSON_BACKEND '$backend'\n";
105    return $backend;
106  }
107  if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
108    _can_load( 'JSON::PP' => 2.27300 )
109      or croak "JSON::PP 2.27300 is not available\n";
110    return 'JSON::PP';
111  }
112  else {
113    _can_load( 'JSON' => 2.5 )
114      or croak  "JSON 2.5 is required for " .
115                "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
116    return "JSON";
117  }
118}
119
120sub _slurp {
121  require Encode;
122  open my $fh, "<:raw", "$_[0]" ## no critic
123    or die "can't open $_[0] for reading: $!";
124  my $content = do { local $/; <$fh> };
125  $content = Encode::decode('UTF-8', $content, Encode::PERLQQ());
126  return $content;
127}
128
129sub _can_load {
130  my ($module, $version) = @_;
131  (my $file = $module) =~ s{::}{/}g;
132  $file .= ".pm";
133  return 1 if $INC{$file};
134  return 0 if exists $INC{$file}; # prior load failed
135  eval { require $file; 1 }
136    or return 0;
137  if ( defined $version ) {
138    eval { $module->VERSION($version); 1 }
139      or return 0;
140  }
141  return 1;
142}
143
144# Kept for backwards compatibility only
145# Create an object from a file
146sub LoadFile ($) { ## no critic
147  return Load(_slurp(shift));
148}
149
150# Parse a document from a string.
151sub Load ($) { ## no critic
152  require CPAN::Meta::YAML;
153  my $object = eval { CPAN::Meta::YAML::Load(shift) };
154  croak $@ if $@;
155  return $object;
156}
157
1581;
159
160__END__
161
162=pod
163
164=encoding UTF-8
165
166=head1 NAME
167
168Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
169
170=head1 VERSION
171
172version 2.150010
173
174=head1 SYNOPSIS
175
176    #############################################
177    # In your file
178
179    ---
180    name: My-Distribution
181    version: 1.23
182    resources:
183      homepage: "http://example.com/dist/My-Distribution"
184
185
186    #############################################
187    # In your program
188
189    use Parse::CPAN::Meta;
190
191    my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
192
193    # Reading properties
194    my $name     = $distmeta->{name};
195    my $version  = $distmeta->{version};
196    my $homepage = $distmeta->{resources}{homepage};
197
198=head1 DESCRIPTION
199
200B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
201L<JSON::PP> and/or L<CPAN::Meta::YAML>.
202
203B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
204and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
205are described below in detail.
206
207B<Parse::CPAN::Meta> provides a legacy API of only two functions,
208based on the YAML functions of the same name. Wherever possible,
209identical calling semantics are used.  These may only be used with YAML sources.
210
211All error reporting is done with exceptions (die'ing).
212
213Note that META files are expected to be in UTF-8 encoding, only.  When
214converted string data, it must first be decoded from UTF-8.
215
216=begin Pod::Coverage
217
218
219
220
221=end Pod::Coverage
222
223=head1 METHODS
224
225=head2 load_file
226
227  my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
228
229  my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
230
231This method will read the named file and deserialize it to a data structure,
232determining whether it should be JSON or YAML based on the filename.
233The file will be read using the ":utf8" IO layer.
234
235=head2 load_yaml_string
236
237  my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
238
239This method deserializes the given string of YAML and returns the first
240document in it.  (CPAN metadata files should always have only one document.)
241If the source was UTF-8 encoded, the string must be decoded before calling
242C<load_yaml_string>.
243
244=head2 load_json_string
245
246  my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
247
248This method deserializes the given string of JSON and the result.
249If the source was UTF-8 encoded, the string must be decoded before calling
250C<load_json_string>.
251
252=head2 load_string
253
254  my $metadata_structure = Parse::CPAN::Meta->load_string($some_string);
255
256If you don't know whether a string contains YAML or JSON data, this method
257will use some heuristics and guess.  If it can't tell, it assumes YAML.
258
259=head2 yaml_backend
260
261  my $backend = Parse::CPAN::Meta->yaml_backend;
262
263Returns the module name of the YAML serializer. See L</ENVIRONMENT>
264for details.
265
266=head2 json_backend
267
268  my $backend = Parse::CPAN::Meta->json_backend;
269
270Returns the module name of the JSON serializer.  If C<CPAN_META_JSON_BACKEND>
271is set, this will be whatever that's set to.  If not, this will either
272be L<JSON::PP> or L<JSON>.  If C<PERL_JSON_BACKEND> is set,
273this will return L<JSON> as further delegation is handled by
274the L<JSON> module.  See L</ENVIRONMENT> for details.
275
276=head2 json_decoder
277
278  my $decoder = Parse::CPAN::Meta->json_decoder;
279
280Returns the module name of the JSON decoder.  Unlike L</json_backend>, this
281is not necessarily a full L<JSON>-style module, but only something that will
282provide a C<decode_json> subroutine.  If C<CPAN_META_JSON_DECODER> is set,
283this will be whatever that's set to.  If not, this will be whatever has
284been selected as L</json_backend>.  See L</ENVIRONMENT> for more notes.
285
286=head1 FUNCTIONS
287
288For maintenance clarity, no functions are exported by default.  These functions
289are available for backwards compatibility only and are best avoided in favor of
290C<load_file>.
291
292=head2 Load
293
294  my @yaml = Parse::CPAN::Meta::Load( $string );
295
296Parses a string containing a valid YAML stream into a list of Perl data
297structures.
298
299=head2 LoadFile
300
301  my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
302
303Reads the YAML stream from a file instead of a string.
304
305=head1 ENVIRONMENT
306
307=head2 CPAN_META_JSON_DECODER
308
309By default, L<JSON::PP> will be used for deserializing JSON data.  If the
310C<CPAN_META_JSON_DECODER> environment variable exists, this is expected to
311be the name of a loadable module that provides a C<decode_json> subroutine,
312which will then be used for deserialization.  Relying only on the existence
313of said subroutine allows for maximum compatibility, since this API is
314provided by all of L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS>,
315L<JSON::MaybeXS>, L<JSON::Tiny>, and L<Mojo::JSON>.
316
317=head2 CPAN_META_JSON_BACKEND
318
319By default, L<JSON::PP> will be used for deserializing JSON data.  If the
320C<CPAN_META_JSON_BACKEND> environment variable exists, this is expected to
321be the name of a loadable module that provides the L<JSON> API, since
322downstream code expects to be able to call C<new> on this class.  As such,
323while L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS> and L<JSON::MaybeXS> will
324work for this, to use L<Mojo::JSON> or L<JSON::Tiny> for decoding requires
325setting L</CPAN_META_JSON_DECODER>.
326
327=head2 PERL_JSON_BACKEND
328
329If the C<CPAN_META_JSON_BACKEND> environment variable does not exist, and if
330C<PERL_JSON_BACKEND> environment variable exists, is true and is not
331"JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
332used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
333old, an exception will be thrown.  Note that at the time of writing, the only
334useful values are 1, which will tell L<JSON> to guess, or L<JSON::XS> - if
335you want to use a newer JSON module, see L</CPAN_META_JSON_BACKEND>.
336
337=head2 PERL_YAML_BACKEND
338
339By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
340the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
341as a module to use for deserialization.  The given module must be installed,
342must load correctly and must implement the C<Load()> function or an exception
343will be thrown.
344
345=head1 AUTHORS
346
347=over 4
348
349=item *
350
351David Golden <dagolden@cpan.org>
352
353=item *
354
355Ricardo Signes <rjbs@cpan.org>
356
357=item *
358
359Adam Kennedy <adamk@cpan.org>
360
361=back
362
363=head1 COPYRIGHT AND LICENSE
364
365This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
366
367This is free software; you can redistribute it and/or modify it under
368the same terms as the Perl 5 programming language system itself.
369
370=cut
371