--- /dev/null
+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.40';\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
projects / catagits/Gitalist.git / blobdiff