-package Parse::CPAN::Meta;
-
-use strict;
-use Carp 'croak';
-BEGIN {
- require 5.004;
- require Exporter;
- $Parse::CPAN::Meta::VERSION = '0.05';
- @Parse::CPAN::Meta::ISA = qw{ Exporter };
- @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
-}
-
-# Prototypes
-sub LoadFile ($);
-sub Load ($);
-sub _scalar ($$$);
-sub _array ($$$);
-sub _hash ($$$);
-
-# Printable characters for escapes
-my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
-);
-
-
-my %BOM = (
- "\357\273\277" => 'UTF-8',
- "\376\377" => 'UTF-16BE',
- "\377\376" => 'UTF-16LE',
- "\0\0\376\377" => 'UTF-32BE',
- "\377\376\0\0" => 'UTF-32LE'
-);
-
-sub BOM_MIN_LENGTH () { 2 }
-sub BOM_MAX_LENGTH () { 4 }
-sub HAVE_UTF8 () { $] >= 5.007003 }
-
-BEGIN { require utf8 if HAVE_UTF8 }
-
-
-#####################################################################
-# Implementation
-
-# Create an object from a file
-sub LoadFile ($) {
- # Check the file
- my $file = shift;
- croak('You did not specify a file name') unless $file;
- croak( "File '$file' does not exist" ) unless -e $file;
- croak( "'$file' is a directory, not a file" ) unless -f _;
- croak( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- open( CFG, $file ) or croak("Failed to open file '$file': $!");
- my $yaml = <CFG>;
- close CFG or croak("Failed to close file '$file': $!");
-
- # Hand off to the actual parser
- Load( $yaml );
-}
-
-# Parse a document from a string.
-# Doing checks on $_[0] prevents us having to do a string copy.
-sub Load ($) {
-
- my $str = $_[0];
-
- # Handle special cases
- foreach my $length ( BOM_MIN_LENGTH .. BOM_MAX_LENGTH ) {
- if ( my $enc = $BOM{substr($str, 0, $length)} ) {
- croak("Stream has a non UTF-8 BOM") unless $enc eq 'UTF-8';
- substr($str, 0, $length) = ''; # strip UTF-8 bom if found, we'll just ignore it
- }
- }
-
- if ( HAVE_UTF8 ) {
- utf8::decode($str); # try to decode as utf8
- }
-
- unless ( defined $str ) {
- croak("Did not provide a string to Load");
- }
- return() unless length $str;
- unless ( $str =~ /[\012\015]+$/ ) {
- croak("Stream does not end with newline character");
- }
-
- # Split the file into lines
- my @lines = grep { ! /^\s*(?:\#.*)?$/ }
- split /(?:\015{1,2}\012|\015|\012)/, $str;
-
- # A nibbling parser
- my @documents = ();
- while ( @lines ) {
- # Do we have a document header?
- if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?$/ ) {
- # Handle scalar documents
- shift @lines;
- if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML:[\d\.]+)$/ ) {
- push @documents, _scalar( "$1", [ undef ], \@lines );
- next;
- }
- }
-
- if ( ! @lines or $lines[0] =~ /^---\s*(?:(.+)\s*)?$/ ) {
- # A naked document
- push @documents, undef;
-
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
- # An array at the root
- my $document = [ ];
- push @documents, $document;
- _array( $document, [ 0 ], \@lines );
-
- } elsif ( $lines[0] =~ /^(\s*)\w/ ) {
- # A hash at the root
- my $document = { };
- push @documents, $document;
- _hash( $document, [ length($1) ], \@lines );
-
- } else {
- croak("Parse::CPAN::Meta does not support the line '$lines[0]'");
- }
- }
-
- if ( wantarray ) {
- return @documents;
- } else {
- return $documents[-1];
- }
-}
-
-# Deparse a scalar string to the actual scalar
-sub _scalar ($$$) {
- my $string = shift;
- my $indent = shift;
- my $lines = shift;
-
- # Trim trailing whitespace
- $string =~ s/\s*$//;
-
- # Explitic null/undef
- return undef if $string eq '~';
-
- # Quotes
- if ( $string =~ /^\'(.*?)\'$/ ) {
- return '' unless defined $1;
- my $rv = $1;
- $rv =~ s/\'\'/\'/g;
- return $rv;
- }
- if ( $string =~ /^\"((?:\\.|[^\"])*)\"$/ ) {
- my $str = $1;
- $str =~ s/\\"/"/g;
- $str =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
- return $str;
- }
- if ( $string =~ /^[\'\"]/ ) {
- # A quote with folding... we don't support that
- croak("Parse::CPAN::Meta does not support multi-line quoted scalars");
- }
-
- # Null hash and array
- if ( $string eq '{}' ) {
- # Null hash
- return {};
- }
- if ( $string eq '[]' ) {
- # Null array
- return [];
- }
-
- # Regular unquoted string
- return $string unless $string =~ /^[>|]/;
-
- # Error
- croak("Multi-line scalar content missing") unless @$lines;
-
- # Check the indent depth
- $lines->[0] =~ /^(\s*)/;
- $indent->[-1] = length("$1");
- if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
- croak("Illegal line indenting");
- }
-
- # Pull the lines
- my @multiline = ();
- while ( @$lines ) {
- $lines->[0] =~ /^(\s*)/;
- last unless length($1) >= $indent->[-1];
- push @multiline, substr(shift(@$lines), length($1));
- }
-
- my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
- my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
- return join( $j, @multiline ) . $t;
-}
-
-# Parse an array
-sub _array ($$$) {
- my $array = shift;
- my $indent = shift;
- my $lines = shift;
-
- while ( @$lines ) {
- # Check for a new document
- return 1 if $lines->[0] =~ /^---\s*(?:(.+)\s*)?$/;
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Hash line over-indented");
- }
-
- if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
- # Inline nested hash
- my $indent2 = length("$1");
- $lines->[0] =~ s/-/ /;
- push @$array, { };
- _hash( $array->[-1], [ @$indent, $indent2 ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*$/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-\s*$/ ) {
- shift @$lines;
- unless ( @$lines ) {
- push @$array, undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)\-/ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] == $indent2 ) {
- # Null array entry
- push @$array, undef;
- } else {
- # Naked indenter
- push @$array, [ ];
- _array( $array->[-1], [ @$indent, $indent2 ], $lines );
- }
-
- } elsif ( $lines->[0] =~ /^(\s*)\w/ ) {
- push @$array, { };
- _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- croak("Parse::CPAN::Meta does not support the line '$lines->[0]'");
- }
-
- } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
- # This is probably a structure like the following...
- # ---
- # foo:
- # - list
- # bar: value
- #
- # ... so lets return and let the hash parser handle it
- return 1;
-
- } else {
- croak("Parse::CPAN::Meta does not support the line '$lines->[0]'");
- }
- }
-
- return 1;
-}
-
-# Parse an array
-sub _hash ($$$) {
- my $hash = shift;
- my $indent = shift;
- my $lines = shift;
-
- while ( @$lines ) {
- # Check for a new document
- return 1 if $lines->[0] =~ /^---\s*(?:(.+)\s*)?$/;
-
- # Check the indent level
- $lines->[0] =~/^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Hash line over-indented");
- }
-
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\"][^\n]*?)\s*:(\s+|$)// ) {
- croak("Bad hash line");
- }
- my $key = $1;
-
- # Do we have a value?
- if ( length $lines->[0] ) {
- # Yes
- $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
- next;
- }
-
- # An indent
- shift @$lines;
- unless ( @$lines ) {
- $hash->{$key} = undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)-/ ) {
- $hash->{$key} = [];
- _array( $hash->{$key}, [ @$indent, length($1) ], $lines );
- } elsif ( $lines->[0] =~ /^(\s*)./ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] >= $indent2 ) {
- # Null hash entry
- $hash->{$key} = undef;
- } else {
- $hash->{$key} = {};
- _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
- }
- }
- }
-
- return 1;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
-
-=head1 SYNOPSIS
-
- #############################################
- # In your file
-
- ---
- rootproperty: blah
- section:
- one: two
- three: four
- Foo: Bar
- empty: ~
-
-
-
- #############################################
- # In your program
-
- use Parse::CPAN::Meta;
-
- # Create a YAML file
- my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );
-
- # Reading properties
- my $root = $yaml[0]->{rootproperty};
- my $one = $yaml[0]->{section}->{one};
- my $Foo = $yaml[0]->{section}->{Foo};
-
-=head1 DESCRIPTION
-
-B<Parse::CPAN::Meta> is a parser for META.yml files, based on the
-parser half of L<YAML::Tiny>.
-
-It supports a basic subset of the full YAML specification, enough to
-implement parsing of typical META.yml files, and other similarly simple
-YAML files.
-
-If you need something with more power, move up to a full YAML parser such
-as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.
-
-Parse::CPAN::Meta provides a very simply API of only two functions, based
-on the YAML functions of the same name. Wherever possible, identical
-calling semantics are used.
-
-All error reporting is done with exceptions (dieing).
-
-=head1 FUNCTIONS
-
-For maintenance clarity, no functions are exported.
-
-=head2 Load( $string )
-
- my @documents = Load( $string );
-
-Parses a string containing a valid YAML stream into a list of Perl data
-structures.
-
-=head2 LoadFile( $file_name )
-
-Reads the YAML stream from a file instead of a string.
-
-=head1 SUPPORT
-
-Bugs should be reported via the CPAN bug tracker at
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-=head1 SEE ALSO
-
-L<YAML::Tiny>, L<YAML>, L<YAML::Syck>
-
-=head1 COPYRIGHT
-
-Copyright 2006 - 2009 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
+package Parse::CPAN::Meta;\r
+\r
+use strict;\r
+use Carp 'croak';\r
+\r
+# UTF Support?\r
+sub HAVE_UTF8 () { $] >= 5.007003 }\r
+BEGIN {\r
+ if ( HAVE_UTF8 ) {\r
+ # The string eval helps hide this from Test::MinimumVersion\r
+ eval "require utf8;";\r
+ die "Failed to load UTF-8 support" if $@;\r
+ }\r
+\r
+ # Class structure\r
+ require 5.004;\r
+ require Exporter;\r
+ $Parse::CPAN::Meta::VERSION = '1.38';\r
+ @Parse::CPAN::Meta::ISA = qw{ Exporter };\r
+ @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };\r
+}\r
+\r
+# Prototypes\r
+sub LoadFile ($);\r
+sub Load ($);\r
+sub _scalar ($$$);\r
+sub _array ($$$);\r
+sub _hash ($$$);\r
+\r
+# Printable characters for escapes\r
+my %UNESCAPES = (\r
+ z => "\x00", a => "\x07", t => "\x09",\r
+ n => "\x0a", v => "\x0b", f => "\x0c",\r
+ r => "\x0d", e => "\x1b", '\\' => '\\',\r
+);\r
+\r
+\r
+\r
+\r
+\r
+#####################################################################\r
+# Implementation\r
+\r
+# Create an object from a file\r
+sub LoadFile ($) {\r
+ # Check the file\r
+ my $file = shift;\r
+ croak('You did not specify a file name') unless $file;\r
+ croak( "File '$file' does not exist" ) unless -e $file;\r
+ croak( "'$file' is a directory, not a file" ) unless -f _;\r
+ croak( "Insufficient permissions to read '$file'" ) unless -r _;\r
+\r
+ # Slurp in the file\r
+ local $/ = undef;\r
+ local *CFG;\r
+ unless ( open( CFG, $file ) ) {\r
+ croak("Failed to open file '$file': $!");\r
+ }\r
+ my $yaml = <CFG>;\r
+ unless ( close(CFG) ) {\r
+ croak("Failed to close file '$file': $!");\r
+ }\r
+\r
+ # Hand off to the actual parser\r
+ Load( $yaml );\r
+}\r
+\r
+# Parse a document from a string.\r
+# Doing checks on $_[0] prevents us having to do a string copy.\r
+sub Load ($) {\r
+ my $string = $_[0];\r
+ unless ( defined $string ) {\r
+ croak("Did not provide a string to load");\r
+ }\r
+\r
+ # Byte order marks\r
+ if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {\r
+ croak("Stream has a non UTF-8 Unicode Byte Order Mark");\r
+ } else {\r
+ # Strip UTF-8 bom if found, we'll just ignore it\r
+ $string =~ s/^\357\273\277//;\r
+ }\r
+\r
+ # Try to decode as utf8\r
+ utf8::decode($string) if HAVE_UTF8;\r
+\r
+ # Check for some special cases\r
+ return () unless length $string;\r
+ unless ( $string =~ /[\012\015]+\z/ ) {\r
+ croak("Stream does not end with newline character");\r
+ }\r
+\r
+ # Split the file into lines\r
+ my @lines = grep { ! /^\s*(?:\#.*)?\z/ }\r
+ split /(?:\015{1,2}\012|\015|\012)/, $string;\r
+\r
+ # Strip the initial YAML header\r
+ @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;\r
+\r
+ # A nibbling parser\r
+ my @documents = ();\r
+ while ( @lines ) {\r
+ # Do we have a document header?\r
+ if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {\r
+ # Handle scalar documents\r
+ shift @lines;\r
+ if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {\r
+ push @documents, _scalar( "$1", [ undef ], \@lines );\r
+ next;\r
+ }\r
+ }\r
+\r
+ if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {\r
+ # A naked document\r
+ push @documents, undef;\r
+ while ( @lines and $lines[0] !~ /^---/ ) {\r
+ shift @lines;\r
+ }\r
+\r
+ } elsif ( $lines[0] =~ /^\s*\-/ ) {\r
+ # An array at the root\r
+ my $document = [ ];\r
+ push @documents, $document;\r
+ _array( $document, [ 0 ], \@lines );\r
+\r
+ } elsif ( $lines[0] =~ /^(\s*)\S/ ) {\r
+ # A hash at the root\r
+ my $document = { };\r
+ push @documents, $document;\r
+ _hash( $document, [ length($1) ], \@lines );\r
+\r
+ } else {\r
+ croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");\r
+ }\r
+ }\r
+\r
+ if ( wantarray ) {\r
+ return @documents;\r
+ } else {\r
+ return $documents[-1];\r
+ }\r
+}\r
+\r
+# Deparse a scalar string to the actual scalar\r
+sub _scalar ($$$) {\r
+ my ($string, $indent, $lines) = @_;\r
+\r
+ # Trim trailing whitespace\r
+ $string =~ s/\s*\z//;\r
+\r
+ # Explitic null/undef\r
+ return undef if $string eq '~';\r
+\r
+ # Quotes\r
+ if ( $string =~ /^\'(.*?)\'\z/ ) {\r
+ return '' unless defined $1;\r
+ $string = $1;\r
+ $string =~ s/\'\'/\'/g;\r
+ return $string;\r
+ }\r
+ if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {\r
+ # Reusing the variable is a little ugly,\r
+ # but avoids a new variable and a string copy.\r
+ $string = $1;\r
+ $string =~ s/\\"/"/g;\r
+ $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;\r
+ return $string;\r
+ }\r
+\r
+ # Special cases\r
+ if ( $string =~ /^[\'\"!&]/ ) {\r
+ croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");\r
+ }\r
+ return {} if $string eq '{}';\r
+ return [] if $string eq '[]';\r
+\r
+ # Regular unquoted string\r
+ return $string unless $string =~ /^[>|]/;\r
+\r
+ # Error\r
+ croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;\r
+\r
+ # Check the indent depth\r
+ $lines->[0] =~ /^(\s*)/;\r
+ $indent->[-1] = length("$1");\r
+ if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {\r
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");\r
+ }\r
+\r
+ # Pull the lines\r
+ my @multiline = ();\r
+ while ( @$lines ) {\r
+ $lines->[0] =~ /^(\s*)/;\r
+ last unless length($1) >= $indent->[-1];\r
+ push @multiline, substr(shift(@$lines), length($1));\r
+ }\r
+\r
+ my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";\r
+ my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";\r
+ return join( $j, @multiline ) . $t;\r
+}\r
+\r
+# Parse an array\r
+sub _array ($$$) {\r
+ my ($array, $indent, $lines) = @_;\r
+\r
+ while ( @$lines ) {\r
+ # Check for a new document\r
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {\r
+ while ( @$lines and $lines->[0] !~ /^---/ ) {\r
+ shift @$lines;\r
+ }\r
+ return 1;\r
+ }\r
+\r
+ # Check the indent level\r
+ $lines->[0] =~ /^(\s*)/;\r
+ if ( length($1) < $indent->[-1] ) {\r
+ return 1;\r
+ } elsif ( length($1) > $indent->[-1] ) {\r
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");\r
+ }\r
+\r
+ if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {\r
+ # Inline nested hash\r
+ my $indent2 = length("$1");\r
+ $lines->[0] =~ s/-/ /;\r
+ push @$array, { };\r
+ _hash( $array->[-1], [ @$indent, $indent2 ], $lines );\r
+\r
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {\r
+ # Array entry with a value\r
+ shift @$lines;\r
+ push @$array, _scalar( "$2", [ @$indent, undef ], $lines );\r
+\r
+ } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {\r
+ shift @$lines;\r
+ unless ( @$lines ) {\r
+ push @$array, undef;\r
+ return 1;\r
+ }\r
+ if ( $lines->[0] =~ /^(\s*)\-/ ) {\r
+ my $indent2 = length("$1");\r
+ if ( $indent->[-1] == $indent2 ) {\r
+ # Null array entry\r
+ push @$array, undef;\r
+ } else {\r
+ # Naked indenter\r
+ push @$array, [ ];\r
+ _array( $array->[-1], [ @$indent, $indent2 ], $lines );\r
+ }\r
+\r
+ } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {\r
+ push @$array, { };\r
+ _hash( $array->[-1], [ @$indent, length("$1") ], $lines );\r
+\r
+ } else {\r
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");\r
+ }\r
+\r
+ } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {\r
+ # This is probably a structure like the following...\r
+ # ---\r
+ # foo:\r
+ # - list\r
+ # bar: value\r
+ #\r
+ # ... so lets return and let the hash parser handle it\r
+ return 1;\r
+\r
+ } else {\r
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");\r
+ }\r
+ }\r
+\r
+ return 1;\r
+}\r
+\r
+# Parse an array\r
+sub _hash ($$$) {\r
+ my ($hash, $indent, $lines) = @_;\r
+\r
+ while ( @$lines ) {\r
+ # Check for a new document\r
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {\r
+ while ( @$lines and $lines->[0] !~ /^---/ ) {\r
+ shift @$lines;\r
+ }\r
+ return 1;\r
+ }\r
+\r
+ # Check the indent level\r
+ $lines->[0] =~ /^(\s*)/;\r
+ if ( length($1) < $indent->[-1] ) {\r
+ return 1;\r
+ } elsif ( length($1) > $indent->[-1] ) {\r
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");\r
+ }\r
+\r
+ # Get the key\r
+ unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {\r
+ if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {\r
+ croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");\r
+ }\r
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");\r
+ }\r
+ my $key = $1;\r
+\r
+ # Do we have a value?\r
+ if ( length $lines->[0] ) {\r
+ # Yes\r
+ $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );\r
+ } else {\r
+ # An indent\r
+ shift @$lines;\r
+ unless ( @$lines ) {\r
+ $hash->{$key} = undef;\r
+ return 1;\r
+ }\r
+ if ( $lines->[0] =~ /^(\s*)-/ ) {\r
+ $hash->{$key} = [];\r
+ _array( $hash->{$key}, [ @$indent, length($1) ], $lines );\r
+ } elsif ( $lines->[0] =~ /^(\s*)./ ) {\r
+ my $indent2 = length("$1");\r
+ if ( $indent->[-1] >= $indent2 ) {\r
+ # Null hash entry\r
+ $hash->{$key} = undef;\r
+ } else {\r
+ $hash->{$key} = {};\r
+ _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );\r
+ }\r
+ }\r
+ }\r
+ }\r
+\r
+ return 1;\r
+}\r
+\r
+1;\r
+\r
+__END__\r
+\r
+=pod\r
+\r
+=head1 NAME\r
+\r
+Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files\r
+\r
+=head1 SYNOPSIS\r
+\r
+ #############################################\r
+ # In your file\r
+ \r
+ ---\r
+ rootproperty: blah\r
+ section:\r
+ one: two\r
+ three: four\r
+ Foo: Bar\r
+ empty: ~\r
+ \r
+ \r
+ \r
+ #############################################\r
+ # In your program\r
+ \r
+ use Parse::CPAN::Meta;\r
+ \r
+ # Create a YAML file\r
+ my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );\r
+ \r
+ # Reading properties\r
+ my $root = $yaml[0]->{rootproperty};\r
+ my $one = $yaml[0]->{section}->{one};\r
+ my $Foo = $yaml[0]->{section}->{Foo};\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the\r
+parser half of L<YAML::Tiny>.\r
+\r
+It supports a basic subset of the full YAML specification, enough to\r
+implement parsing of typical F<META.yml> files, and other similarly simple\r
+YAML files.\r
+\r
+If you need something with more power, move up to a full YAML parser such\r
+as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.\r
+\r
+B<Parse::CPAN::Meta> provides a very simply API of only two functions,\r
+based on the YAML functions of the same name. Wherever possible,\r
+identical calling semantics are used.\r
+\r
+All error reporting is done with exceptions (die'ing).\r
+\r
+=head1 FUNCTIONS\r
+\r
+For maintenance clarity, no functions are exported.\r
+\r
+=head2 Load\r
+\r
+ my @yaml = Load( $string );\r
+\r
+Parses a string containing a valid YAML stream into a list of Perl data\r
+structures.\r
+\r
+=head2 LoadFile\r
+\r
+ my @yaml = LoadFile( 'META.yml' );\r
+\r
+Reads the YAML stream from a file instead of a string.\r
+\r
+=head1 SUPPORT\r
+\r
+Bugs should be reported via the CPAN bug tracker at\r
+\r
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>\r
+\r
+=head1 AUTHOR\r
+\r
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>\r
+\r
+=head1 SEE ALSO\r
+\r
+L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,\r
+L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>\r
+\r
+=head1 COPYRIGHT\r
+\r
+Copyright 2006 - 2009 Adam Kennedy.\r
+\r
+This program is free software; you can redistribute\r
+it and/or modify it under the same terms as Perl itself.\r
+\r
+The full text of the license can be found in the\r
+LICENSE file included with this module.\r
+\r
+=cut\r
use File::Spec::Functions ':ALL';
use Parse::CPAN::Meta::Test;
-use Test::More tests(20);
+use Test::More tests(37);
);
# Piped multi-line scalar
-yaml_ok( <<'END_YAML', [ [ "foo\nbar\n", 1 ] ], 'indented', nosyck => 1 );
+yaml_ok(
+ <<'END_YAML',
---
- |
foo
bar
- 1
END_YAML
+ [ [ "foo\nbar\n", 1 ] ],
+ 'indented',
+);
# ... with a pointless hyphen
-yaml_ok( <<'END_YAML', [ [ "foo\nbar", 1 ] ], 'indented', nosyck => 1 );
+yaml_ok( <<'END_YAML',
---
- |-
foo
bar
- 1
END_YAML
-
+ [ [ "foo\nbar", 1 ] ],
+ 'indented',
+);
#####################################################################
-# Support for YAML document version declarations
+# Support for YAML version directives
-# Simple case
+# Simple inline case (comment variant)
yaml_ok(
<<'END_YAML',
--- #YAML:1.0
foo: bar
END_YAML
[ { foo => 'bar' } ],
- 'simple_doctype',
+ 'simple_doctype_comment',
+ nosyck => 1,
+);
+
+# Simple inline case (percent variant)
+yaml_ok(
+ <<'END_YAML',
+--- %YAML:1.0
+foo: bar
+END_YAML
+ [ { foo => 'bar' } ],
+ 'simple_doctype_percent',
+ noyamlpm => 1,
+ noxs => 1,
+ noyamlperl => 1,
+);
+
+# Simple header (comment variant)
+yaml_ok(
+ <<'END_YAML',
+%YAML:1.0
+---
+foo: bar
+END_YAML
+ [ { foo => 'bar' } ],
+ 'predocument_1_0',
+ noyamlpm => 1,
+ nosyck => 1,
+ noxs => 1,
+ noyamlperl => 1,
);
-# Multiple documents
+# Simple inline case (comment variant)
+yaml_ok(
+ <<'END_YAML',
+%YAML 1.1
+---
+foo: bar
+END_YAML
+ [ { foo => 'bar' } ],
+ 'predocument_1_1',
+ noyamlpm => 1,
+ nosyck => 1,
+ noyamlperl => 1,
+);
+
+# Multiple inline documents (comment variant)
yaml_ok(
<<'END_YAML',
--- #YAML:1.0
foo: bar
END_YAML
[ { foo => 'bar' }, [ 1 ], { foo => 'bar' } ],
- 'multi_doctype',
+ 'multi_doctype_comment',
+);
+
+# Simple pre-document case (comment variant)
+yaml_ok(
+ <<'END_YAML',
+%YAML 1.1
+---
+foo: bar
+END_YAML
+ [ { foo => 'bar' } ],
+ 'predocument_percent',
+ noyamlpm => 1,
+ nosyck => 1,
+ noyamlperl => 1,
+);
+
+# Simple pre-document case (comment variant)
+yaml_ok(
+ <<'END_YAML',
+#YAML 1.1
+---
+foo: bar
+END_YAML
+ [ { foo => 'bar' } ],
+ 'predocument_comment',
);
- ~
- 'bar'
END_YAML
- [ { abstract => 'Generate fractal curves', foo => undef, arr => [ 'foo', undef, 'bar' ] } ],
+ [ {
+ abstract => 'Generate fractal curves',
+ foo => undef,
+ arr => [ 'foo', undef, 'bar' ],
+ } ],
'trailing whitespace',
+ noyamlperl => 1,
);
#####################################################################
-# Single Quote Idiosyncracy
+# Quote and Escaping Idiosyncracies
+
+yaml_ok(
+ <<'END_YAML',
+---
+name1: 'O''Reilly'
+name2: 'O''Reilly O''Tool'
+name3: 'Double '''' Quote'
+END_YAML
+ [ {
+ name1 => "O'Reilly",
+ name2 => "O'Reilly O'Tool",
+ name3 => "Double '' Quote",
+ } ],
+ 'single quote subtleties',
+);
yaml_ok(
<<'END_YAML',
---
-slash: '\\'
-name: 'O''Reilly'
+slash1: '\\'
+slash2: '\\foo'
+slash3: '\\foo\\\\'
END_YAML
- [ { slash => "\\\\", name => "O'Reilly" } ],
+ [ {
+ slash1 => "\\\\",
+ slash2 => "\\\\foo",
+ slash3 => "\\\\foo\\\\\\\\",
+ } ],
'single quote subtleties',
);
END_YAML
[ { foo => 0, requires => undef, build_requires => undef } ],
'empty hash keys',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
yaml_ok(
END_YAML
[ [ 'foo', undef, undef ] ],
'empty array keys',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
END_YAML
[ { foo => 'bar' } ],
'comment header',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
+#####################################################################
+# Confirm we can read the synopsis
+
+yaml_ok(
+ <<'END_YAML',
+---
+rootproperty: blah
+section:
+ one: two
+ three: four
+ Foo: Bar
+ empty: ~
+END_YAML
+ [ {
+ rootproperty => 'blah',
+ section => {
+ one => 'two',
+ three => 'four',
+ Foo => 'Bar',
+ empty => undef,
+ },
+ } ],
+ 'synopsis',
+ noyamlperl => 1,
+);
+
+
+
+
+
+#####################################################################
+# Unprintable Characters
+
+yaml_ok(
+ "--- \"foo\\n\\x00\"\n",
+ [ "foo\n\0" ],
+ 'unprintable',
+);
+
+
+
+
+
+#####################################################################
+# Empty Quote Line
+
+yaml_ok(
+ <<'END_YAML',
+---
+- foo
+#
+- bar
+END_YAML
+ [ [ "foo", "bar" ] ],
+);
+
+
+
+
+
+#####################################################################
+# Indentation after empty hash value
+
+yaml_ok(
+ <<'END_YAML',
+---
+Test:
+ optmods:
+ Bad: 0
+ Foo: 1
+ Long: 0
+ version: 5
+Test_IncludeA:
+ optmods:
+Test_IncludeB:
+ optmods:
+_meta:
+ name: 'test profile'
+ note: 'note this test profile'
+END_YAML
+ [ {
+ Test => {
+ optmods => {
+ Bad => 0,
+ Foo => 1,
+ Long => 0,
+ },
+ version => 5,
+ },
+ Test_IncludeA => {
+ optmods => undef,
+ },
+ Test_IncludeB => {
+ optmods => undef,
+ },
+ _meta => {
+ name => 'test profile',
+ note => 'note this test profile',
+ },
+ } ],
+ 'Indentation after empty hash value',
+ noyamlperl => 1,
+);
+
+
+
+
+
+#####################################################################
+# Spaces in the Key
+
+yaml_ok(
+ <<'END_YAML',
+---
+the key: the value
+END_YAML
+ [ { 'the key' => 'the value' } ],
+);
+
+
+
+
+
+#####################################################################
+# Ticker #32402
+
+# Tests a particular pathological case
+
+yaml_ok(
+ <<'END_YAML',
+---
+- value
+- '><'
+END_YAML
+ [ [ 'value', '><' ] ],
+ 'Pathological >< case',
+);
+
+
+
+
+
+#####################################################################
+# Special Characters
+
+#yaml_ok(
+# <<'END_YAML',
+#---
+#- "Ingy d\xC3\xB6t Net"
+#END_YAML
+# [ [ "Ingy d\xC3\xB6t Net" ] ],
+#);
+
+
+
+
+
######################################################################
# Non-Indenting Sub-List
END_YAML
[ { foo => [ 'list' ], bar => 'value' } ],
'Non-indenting sub-list',
+ noyamlpm => 1,
+ noyamlperl => 1,
+);
+
+
+
+
+
+
+#####################################################################
+# Check Multiple-Escaping
+
+# RT #42119: write of two single quotes
+yaml_ok(
+ "--- \"A'B'C\"\n",
+ [ "A'B'C" ],
+ 'Multiple escaping of quote ok',
+);
+
+# Escapes without whitespace
+yaml_ok(
+ "--- A\\B\\C\n",
+ [ "A\\B\\C" ],
+ 'Multiple escaping of escape ok',
+);
+
+# Escapes with whitespace
+yaml_ok(
+ "--- 'A\\B \\C'\n",
+ [ "A\\B \\C" ],
+ 'Multiple escaping of escape with whitespace ok',
+);
+
+
+
+
+
+######################################################################
+# Check illegal characters that are in legal places
+
+yaml_ok(
+ "--- 'Wow!'\n",
+ [ "Wow!" ],
+ 'Bang in a quote',
+);
+yaml_ok(
+ "--- 'This&that'\n",
+ [ "This&that" ],
+ 'Ampersand in a quote',
);
projects / p5sagit/p5-mst-13.2.git / commitdiff