1 package Parse::CPAN::Meta;
\r
7 sub HAVE_UTF8 () { $] >= 5.007003 }
\r
10 # The string eval helps hide this from Test::MinimumVersion
\r
11 eval "require utf8;";
\r
12 die "Failed to load UTF-8 support" if $@;
\r
18 $Parse::CPAN::Meta::VERSION = '1.38';
\r
19 @Parse::CPAN::Meta::ISA = qw{ Exporter };
\r
20 @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
\r
30 # Printable characters for escapes
\r
32 z => "\x00", a => "\x07", t => "\x09",
\r
33 n => "\x0a", v => "\x0b", f => "\x0c",
\r
34 r => "\x0d", e => "\x1b", '\\' => '\\',
\r
41 #####################################################################
\r
44 # Create an object from a file
\r
48 croak('You did not specify a file name') unless $file;
\r
49 croak( "File '$file' does not exist" ) unless -e $file;
\r
50 croak( "'$file' is a directory, not a file" ) unless -f _;
\r
51 croak( "Insufficient permissions to read '$file'" ) unless -r _;
\r
56 unless ( open( CFG, $file ) ) {
\r
57 croak("Failed to open file '$file': $!");
\r
60 unless ( close(CFG) ) {
\r
61 croak("Failed to close file '$file': $!");
\r
64 # Hand off to the actual parser
\r
68 # Parse a document from a string.
\r
69 # Doing checks on $_[0] prevents us having to do a string copy.
\r
72 unless ( defined $string ) {
\r
73 croak("Did not provide a string to load");
\r
77 if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
\r
78 croak("Stream has a non UTF-8 Unicode Byte Order Mark");
\r
80 # Strip UTF-8 bom if found, we'll just ignore it
\r
81 $string =~ s/^\357\273\277//;
\r
84 # Try to decode as utf8
\r
85 utf8::decode($string) if HAVE_UTF8;
\r
87 # Check for some special cases
\r
88 return () unless length $string;
\r
89 unless ( $string =~ /[\012\015]+\z/ ) {
\r
90 croak("Stream does not end with newline character");
\r
93 # Split the file into lines
\r
94 my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
\r
95 split /(?:\015{1,2}\012|\015|\012)/, $string;
\r
97 # Strip the initial YAML header
\r
98 @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
\r
100 # A nibbling parser
\r
101 my @documents = ();
\r
103 # Do we have a document header?
\r
104 if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
\r
105 # Handle scalar documents
\r
107 if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
\r
108 push @documents, _scalar( "$1", [ undef ], \@lines );
\r
113 if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
\r
115 push @documents, undef;
\r
116 while ( @lines and $lines[0] !~ /^---/ ) {
\r
120 } elsif ( $lines[0] =~ /^\s*\-/ ) {
\r
121 # An array at the root
\r
122 my $document = [ ];
\r
123 push @documents, $document;
\r
124 _array( $document, [ 0 ], \@lines );
\r
126 } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
\r
127 # A hash at the root
\r
128 my $document = { };
\r
129 push @documents, $document;
\r
130 _hash( $document, [ length($1) ], \@lines );
\r
133 croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
\r
140 return $documents[-1];
\r
144 # Deparse a scalar string to the actual scalar
\r
145 sub _scalar ($$$) {
\r
146 my ($string, $indent, $lines) = @_;
\r
148 # Trim trailing whitespace
\r
149 $string =~ s/\s*\z//;
\r
151 # Explitic null/undef
\r
152 return undef if $string eq '~';
\r
155 if ( $string =~ /^\'(.*?)\'\z/ ) {
\r
156 return '' unless defined $1;
\r
158 $string =~ s/\'\'/\'/g;
\r
161 if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
\r
162 # Reusing the variable is a little ugly,
\r
163 # but avoids a new variable and a string copy.
\r
165 $string =~ s/\\"/"/g;
\r
166 $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
\r
171 if ( $string =~ /^[\'\"!&]/ ) {
\r
172 croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
\r
174 return {} if $string eq '{}';
\r
175 return [] if $string eq '[]';
\r
177 # Regular unquoted string
\r
178 return $string unless $string =~ /^[>|]/;
\r
181 croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;
\r
183 # Check the indent depth
\r
184 $lines->[0] =~ /^(\s*)/;
\r
185 $indent->[-1] = length("$1");
\r
186 if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
\r
187 croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
\r
191 my @multiline = ();
\r
192 while ( @$lines ) {
\r
193 $lines->[0] =~ /^(\s*)/;
\r
194 last unless length($1) >= $indent->[-1];
\r
195 push @multiline, substr(shift(@$lines), length($1));
\r
198 my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
\r
199 my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
\r
200 return join( $j, @multiline ) . $t;
\r
205 my ($array, $indent, $lines) = @_;
\r
207 while ( @$lines ) {
\r
208 # Check for a new document
\r
209 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
\r
210 while ( @$lines and $lines->[0] !~ /^---/ ) {
\r
216 # Check the indent level
\r
217 $lines->[0] =~ /^(\s*)/;
\r
218 if ( length($1) < $indent->[-1] ) {
\r
220 } elsif ( length($1) > $indent->[-1] ) {
\r
221 croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
\r
224 if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
\r
225 # Inline nested hash
\r
226 my $indent2 = length("$1");
\r
227 $lines->[0] =~ s/-/ /;
\r
229 _hash( $array->[-1], [ @$indent, $indent2 ], $lines );
\r
231 } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
\r
232 # Array entry with a value
\r
234 push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
\r
236 } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
\r
238 unless ( @$lines ) {
\r
239 push @$array, undef;
\r
242 if ( $lines->[0] =~ /^(\s*)\-/ ) {
\r
243 my $indent2 = length("$1");
\r
244 if ( $indent->[-1] == $indent2 ) {
\r
246 push @$array, undef;
\r
250 _array( $array->[-1], [ @$indent, $indent2 ], $lines );
\r
253 } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
\r
255 _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
\r
258 croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
\r
261 } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
\r
262 # This is probably a structure like the following...
\r
268 # ... so lets return and let the hash parser handle it
\r
272 croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
\r
281 my ($hash, $indent, $lines) = @_;
\r
283 while ( @$lines ) {
\r
284 # Check for a new document
\r
285 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
\r
286 while ( @$lines and $lines->[0] !~ /^---/ ) {
\r
292 # Check the indent level
\r
293 $lines->[0] =~ /^(\s*)/;
\r
294 if ( length($1) < $indent->[-1] ) {
\r
296 } elsif ( length($1) > $indent->[-1] ) {
\r
297 croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
\r
301 unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
\r
302 if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
\r
303 croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
\r
305 croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
\r
309 # Do we have a value?
\r
310 if ( length $lines->[0] ) {
\r
312 $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
\r
316 unless ( @$lines ) {
\r
317 $hash->{$key} = undef;
\r
320 if ( $lines->[0] =~ /^(\s*)-/ ) {
\r
321 $hash->{$key} = [];
\r
322 _array( $hash->{$key}, [ @$indent, length($1) ], $lines );
\r
323 } elsif ( $lines->[0] =~ /^(\s*)./ ) {
\r
324 my $indent2 = length("$1");
\r
325 if ( $indent->[-1] >= $indent2 ) {
\r
327 $hash->{$key} = undef;
\r
329 $hash->{$key} = {};
\r
330 _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
\r
347 Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
\r
351 #############################################
\r
364 #############################################
\r
367 use Parse::CPAN::Meta;
\r
369 # Create a YAML file
\r
370 my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );
\r
372 # Reading properties
\r
373 my $root = $yaml[0]->{rootproperty};
\r
374 my $one = $yaml[0]->{section}->{one};
\r
375 my $Foo = $yaml[0]->{section}->{Foo};
\r
379 B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the
\r
380 parser half of L<YAML::Tiny>.
\r
382 It supports a basic subset of the full YAML specification, enough to
\r
383 implement parsing of typical F<META.yml> files, and other similarly simple
\r
386 If you need something with more power, move up to a full YAML parser such
\r
387 as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.
\r
389 B<Parse::CPAN::Meta> provides a very simply API of only two functions,
\r
390 based on the YAML functions of the same name. Wherever possible,
\r
391 identical calling semantics are used.
\r
393 All error reporting is done with exceptions (die'ing).
\r
397 For maintenance clarity, no functions are exported.
\r
401 my @yaml = Load( $string );
\r
403 Parses a string containing a valid YAML stream into a list of Perl data
\r
408 my @yaml = LoadFile( 'META.yml' );
\r
410 Reads the YAML stream from a file instead of a string.
\r
414 Bugs should be reported via the CPAN bug tracker at
\r
416 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
\r
420 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
\r
424 L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
\r
425 L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>
\r
429 Copyright 2006 - 2009 Adam Kennedy.
\r
431 This program is free software; you can redistribute
\r
432 it and/or modify it under the same terms as Perl itself.
\r
434 The full text of the license can be found in the
\r
435 LICENSE file included with this module.
\r