summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm511
1 files changed, 175 insertions, 336 deletions
diff --git a/Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm b/Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm
index e7d585170b1..f7d717cdb1d 100644
--- a/Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm
+++ b/Master/tlpkg/tlperl/lib/Parse/CPAN/Meta.pm
@@ -5,6 +5,8 @@ use Carp 'croak';
# UTF Support?
sub HAVE_UTF8 () { $] >= 5.007003 }
+sub IO_LAYER () { $] >= 5.008001 ? ":utf8" : "" }
+
BEGIN {
if ( HAVE_UTF8 ) {
# The string eval helps hide this from Test::MinimumVersion
@@ -15,400 +17,242 @@ BEGIN {
# Class structure
require 5.004;
require Exporter;
- $Parse::CPAN::Meta::VERSION = '1.40';
+ $Parse::CPAN::Meta::VERSION = '1.4401';
@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 ($$$);
+sub load_file {
+ my ($class, $filename) = @_;
-# Printable characters for escapes
-my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
-);
+ if ($filename =~ /\.ya?ml$/) {
+ return $class->load_yaml_string(_slurp($filename));
+ }
+ if ($filename =~ /\.json$/) {
+ return $class->load_json_string(_slurp($filename));
+ }
+ croak("file type cannot be determined by filename");
+}
+sub load_yaml_string {
+ my ($class, $string) = @_;
+ my $backend = $class->yaml_backend();
+ my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
+ if ( $@ ) {
+ croak $backend->can('errstr') ? $backend->errstr : $@
+ }
+ return $data || {}; # in case document was valid but empty
+}
+
+sub load_json_string {
+ my ($class, $string) = @_;
+ return $class->json_backend()->new->decode($string);
+}
+
+sub yaml_backend {
+ local $Module::Load::Conditional::CHECK_INC_HASH = 1;
+ if (! defined $ENV{PERL_YAML_BACKEND} ) {
+ _can_load( 'CPAN::Meta::YAML', 0.002 )
+ or croak "CPAN::Meta::YAML 0.002 is not available\n";
+ return "CPAN::Meta::YAML";
+ }
+ else {
+ my $backend = $ENV{PERL_YAML_BACKEND};
+ _can_load( $backend )
+ or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
+ $backend->can("Load")
+ or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
+ return $backend;
+ }
+}
+
+sub json_backend {
+ local $Module::Load::Conditional::CHECK_INC_HASH = 1;
+ if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
+ _can_load( 'JSON::PP' => 2.27103 )
+ or croak "JSON::PP 2.27103 is not available\n";
+ return 'JSON::PP';
+ }
+ else {
+ _can_load( 'JSON' => 2.5 )
+ or croak "JSON 2.5 is required for " .
+ "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
+ return "JSON";
+ }
+}
+sub _slurp {
+ open my $fh, "<" . IO_LAYER, "$_[0]"
+ or die "can't open $_[0] for reading: $!";
+ return do { local $/; <$fh> };
+}
-#####################################################################
-# Implementation
+sub _can_load {
+ my ($module, $version) = @_;
+ (my $file = $module) =~ s{::}{/}g;
+ $file .= ".pm";
+ return 1 if $INC{$file};
+ return 0 if exists $INC{$file}; # prior load failed
+ eval { require $file; 1 }
+ or return 0;
+ if ( defined $version ) {
+ eval { $module->VERSION($version); 1 }
+ or return 0;
+ }
+ return 1;
+}
+# Kept for backwards compatibility only
# 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;
- local *CFG;
- unless ( open( CFG, $file ) ) {
- croak("Failed to open file '$file': $!");
- }
- my $yaml = <CFG>;
- unless ( close(CFG) ) {
- croak("Failed to close file '$file': $!");
- }
-
- # Hand off to the actual parser
- Load( $yaml );
+ require CPAN::Meta::YAML;
+ return CPAN::Meta::YAML::LoadFile(shift)
+ or die CPAN::Meta::YAML->errstr;
}
# Parse a document from a string.
-# Doing checks on $_[0] prevents us having to do a string copy.
sub Load ($) {
- my $string = $_[0];
- unless ( defined $string ) {
- croak("Did not provide a string to load");
- }
+ require CPAN::Meta::YAML;
+ return CPAN::Meta::YAML::Load(shift)
+ or die CPAN::Meta::YAML->errstr;
+}
- # Byte order marks
- if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
- croak("Stream has a non UTF-8 Unicode Byte Order Mark");
- } else {
- # Strip UTF-8 bom if found, we'll just ignore it
- $string =~ s/^\357\273\277//;
- }
+1;
- # Try to decode as utf8
- utf8::decode($string) if HAVE_UTF8;
+__END__
- # Check for some special cases
- return () unless length $string;
- unless ( $string =~ /[\012\015]+\z/ ) {
- croak("Stream does not end with newline character");
- }
+=pod
- # Split the file into lines
- my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
- split /(?:\015{1,2}\012|\015|\012)/, $string;
-
- # Strip the initial YAML header
- @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
-
- # A nibbling parser
- my @documents = ();
- while ( @lines ) {
- # Do we have a document header?
- if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
- # Handle scalar documents
- shift @lines;
- if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
- push @documents, _scalar( "$1", [ undef ], \@lines );
- next;
- }
- }
-
- if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
- # A naked document
- push @documents, undef;
- while ( @lines and $lines[0] !~ /^---/ ) {
- shift @lines;
- }
-
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
- # An array at the root
- my $document = [ ];
- push @documents, $document;
- _array( $document, [ 0 ], \@lines );
-
- } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
- # A hash at the root
- my $document = { };
- push @documents, $document;
- _hash( $document, [ length($1) ], \@lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
- }
- }
+=head1 NAME
- if ( wantarray ) {
- return @documents;
- } else {
- return $documents[-1];
- }
-}
+Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
-# Deparse a scalar string to the actual scalar
-sub _scalar ($$$) {
- my ($string, $indent, $lines) = @_;
+=head1 SYNOPSIS
- # Trim trailing whitespace
- $string =~ s/\s*\z//;
+ #############################################
+ # In your file
- # Explitic null/undef
- return undef if $string eq '~';
+ ---
+ name: My-Distribution
+ version: 1.23
+ resources:
+ homepage: "http://example.com/dist/My-Distribution"
- # Quotes
- if ( $string =~ /^\'(.*?)\'\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
- }
- if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
- # Reusing the variable is a little ugly,
- # but avoids a new variable and a string copy.
- $string = $1;
- $string =~ s/\\"/"/g;
- $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
- return $string;
- }
- # Special cases
- if ( $string =~ /^[\'\"!&]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- return {} if $string eq '{}';
- return [] if $string eq '[]';
+ #############################################
+ # In your program
- # Regular unquoted string
- return $string unless $string =~ /^[>|]/;
+ use Parse::CPAN::Meta;
- # Error
- croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;
+ my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
- # Check the indent depth
- $lines->[0] =~ /^(\s*)/;
- $indent->[-1] = length("$1");
- if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
+ # Reading properties
+ my $name = $distmeta->{name};
+ my $version = $distmeta->{version};
+ my $homepage = $distmeta->{resources}{homepage};
- # Pull the lines
- my @multiline = ();
- while ( @$lines ) {
- $lines->[0] =~ /^(\s*)/;
- last unless length($1) >= $indent->[-1];
- push @multiline, substr(shift(@$lines), length($1));
- }
+=head1 DESCRIPTION
- my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
- my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
- return join( $j, @multiline ) . $t;
-}
+B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
+L<JSON::PP> and/or L<CPAN::Meta::YAML>.
-# Parse an array
-sub _array ($$$) {
- my ($array, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- 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*\z/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
- 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*)\S/ ) {
- push @$array, { };
- _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify 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 failed to classify line '$lines->[0]'");
- }
- }
+B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
+and C<load_yaml_string>. These will read and deserialize CPAN metafiles, and
+are described below in detail.
- return 1;
-}
+B<Parse::CPAN::Meta> provides a legacy API of only two functions,
+based on the YAML functions of the same name. Wherever possible,
+identical calling semantics are used. These may only be used with YAML sources.
-# Parse an array
-sub _hash ($$$) {
- my ($hash, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
- if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
- my $key = $1;
-
- # Do we have a value?
- if ( length $lines->[0] ) {
- # Yes
- $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
- } else {
- # 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 );
- }
- }
- }
- }
+All error reporting is done with exceptions (die'ing).
- return 1;
-}
+Note that META files are expected to be in UTF-8 encoding, only. When
+converted string data, it must first be decoded from UTF-8.
-1;
+=head1 METHODS
-__END__
+=head2 load_file
-=pod
+ my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
-=head1 NAME
+ my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
-Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
+This method will read the named file and deserialize it to a data structure,
+determining whether it should be JSON or YAML based on the filename. On
+Perl 5.8.1 or later, the file will be read using the ":utf8" IO layer.
-=head1 SYNOPSIS
+=head2 load_yaml_string
- #############################################
- # 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};
+ my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
-=head1 DESCRIPTION
+This method deserializes the given string of YAML and returns the first
+document in it. (CPAN metadata files should always have only one document.)
+If the source was UTF-8 encoded, the string must be decoded before calling
+C<load_yaml_string>.
-B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the
-parser half of L<YAML::Tiny>.
+=head2 load_json_string
-It supports a basic subset of the full YAML specification, enough to
-implement parsing of typical F<META.yml> files, and other similarly simple
-YAML files.
+ my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
-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>.
+This method deserializes the given string of JSON and the result.
+If the source was UTF-8 encoded, the string must be decoded before calling
+C<load_json_string>.
-B<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.
+=head2 yaml_backend
-All error reporting is done with exceptions (die'ing).
+ my $backend = Parse::CPAN::Meta->yaml_backend;
+
+Returns the module name of the YAML serializer. See L</ENVIRONMENT>
+for details.
+
+=head2 json_backend
+
+ my $backend = Parse::CPAN::Meta->json_backend;
+
+Returns the module name of the JSON serializer. This will either
+be L<JSON::PP> or L<JSON>. Even if C<PERL_JSON_BACKEND> is set,
+this will return L<JSON> as further delegation is handled by
+the L<JSON> module. See L</ENVIRONMENT> for details.
=head1 FUNCTIONS
-For maintenance clarity, no functions are exported.
+For maintenance clarity, no functions are exported. These functions are
+available for backwards compatibility only and are best avoided in favor of
+C<load_file>.
=head2 Load
- my @yaml = Load( $string );
+ my @yaml = Parse::CPAN::Meta::Load( $string );
Parses a string containing a valid YAML stream into a list of Perl data
structures.
=head2 LoadFile
- my @yaml = LoadFile( 'META.yml' );
+ my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
Reads the YAML stream from a file instead of a string.
+=head1 ENVIRONMENT
+
+=head2 PERL_JSON_BACKEND
+
+By default, L<JSON::PP> will be used for deserializing JSON data. If the
+C<PERL_JSON_BACKEND> environment variable exists, is true and is not
+"JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
+used to interpret C<PERL_JSON_BACKEND>. If L<JSON> is not installed or is too
+old, an exception will be thrown.
+
+=head2 PERL_YAML_BACKEND
+
+By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
+the C<PERL_YAML_BACKEND> environment variable is defined, then it is intepreted
+as a module to use for deserialization. The given module must be installed,
+must load correctly and must implement the C<Load()> function or an exception
+will be thrown.
+
=head1 SUPPORT
Bugs should be reported via the CPAN bug tracker at
@@ -419,14 +263,9 @@ L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-=head1 SEE ALSO
-
-L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
-L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>
-
=head1 COPYRIGHT
-Copyright 2006 - 2009 Adam Kennedy.
+Copyright 2006 - 2010 Adam Kennedy.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 17:21:59 +0000