diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm | 162 |
1 files changed, 139 insertions, 23 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm index 772d5792b12..1bb4431f2b2 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm @@ -2,13 +2,31 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Converter; -our $VERSION = '2.120921'; # VERSION +our $VERSION = '2.140640'; # VERSION +# =head1 SYNOPSIS +# +# my $struct = decode_json_file('META.json'); +# +# my $cmc = CPAN::Meta::Converter->new( $struct ); +# +# my $new_struct = $cmc->convert( version => "2" ); +# +# =head1 DESCRIPTION +# +# This module converts CPAN Meta structures from one form to another. The +# primary use is to convert older structures to the most modern version of +# the specification, but other transformations may be implemented in the +# future as needed. (E.g. stripping all custom fields or stripping all +# optional fields.) +# +# =cut use CPAN::Meta::Validator; use CPAN::Meta::Requirements; use version 0.88 (); use Parse::CPAN::Meta 1.4400 (); +use List::Util 1.33 qw/all/; sub _dclone { my $ref = shift; @@ -60,7 +78,7 @@ sub _generated_by { my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>"); return $sig unless defined $gen and length $gen; - return $gen if $gen =~ /(, )\Q$sig/; + return $gen if $gen =~ /\Q$sig/; return "$gen, $sig"; } @@ -80,14 +98,21 @@ sub _ucfirst_custom { return $key; } +sub _no_prefix_ucfirst_custom { + my $key = shift; + $key =~ s/^x_//; + return _ucfirst_custom($key); +} + sub _change_meta_spec { my ($element, undef, undef, $version) = @_; - $element->{version} = $version; - $element->{url} = $known_specs{$version}; - return $element; + return { + version => $version, + url => $known_specs{$version}, + }; } -my @valid_licenses_1 = ( +my @open_source = ( 'perl', 'gpl', 'apache', @@ -99,6 +124,12 @@ my @valid_licenses_1 = ( 'mit', 'mozilla', 'open_source', +); + +my %is_open_source = map {; $_ => 1 } @open_source; + +my @valid_licenses_1 = ( + @open_source, 'unrestricted', 'restrictive', 'unknown', @@ -115,7 +146,9 @@ sub _license_1 { if ( $license_map_1{lc $element} ) { return $license_map_1{lc $element}; } - return 'unknown'; + else { + return 'unknown'; + } } my @valid_licenses_2 = qw( @@ -213,12 +246,20 @@ sub _downgrade_license { return "unknown"; } elsif( ref $element eq 'ARRAY' ) { - if ( @$element == 1 ) { - return $license_downgrade_map{$element->[0]} || "unknown"; + if ( @$element > 1) { + if ( all { $is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element ) { + return 'open_source'; + } + else { + return 'unknown'; + } + } + elsif ( @$element == 1 ) { + return $license_downgrade_map{lc $element->[0]} || "unknown"; } } elsif ( ! ref $element ) { - return $license_downgrade_map{$element} || "unknown"; + return $license_downgrade_map{lc $element} || "unknown"; } return "unknown"; } @@ -307,7 +348,7 @@ sub _is_module_name { } sub _clean_version { - my ($element, $key, $meta, $to_version) = @_; + my ($element) = @_; return 0 if ! defined $element; $element =~ s{^\s*}{}; @@ -342,7 +383,7 @@ sub _version_map { # XXX turn this into CPAN::Meta::Requirements with bad version hook # and then turn it back into a hash my $new_map = CPAN::Meta::Requirements->new( - { bad_version_hook => sub { version->new(0) } } # punt + { bad_version_hook => \&_bad_version_hook } # punt ); while ( my ($k,$v) = each %$element ) { next unless _is_module_name($k); @@ -653,7 +694,7 @@ my $resource_downgrade_spec = { homepage => \&_url_or_drop, bugtracker => sub { return $_[0]->{web} }, repository => sub { return $_[0]->{url} || $_[0]->{web} }, - ':custom' => \&_ucfirst_custom, + ':custom' => \&_no_prefix_ucfirst_custom, }; sub _downgrade_resources { @@ -676,12 +717,12 @@ sub _release_status_from_version { my $provides_spec = { file => \&_keep, - version => \&_clean_version, + version => \&_keep, }; my $provides_spec_2 = { file => \&_keep, - version => \&_clean_version, + version => \&_keep, ':custom' => \&_prefix_custom, }; @@ -692,6 +733,8 @@ sub _provides { my $new_data = {}; for my $k ( keys %$element ) { $new_data->{$k} = _convert($element->{$k}, $spec, $to_version); + $new_data->{$k}{version} = _clean_version($element->{$k}{version}) + if exists $element->{$k}{version}; } return $new_data; } @@ -1191,6 +1234,15 @@ my %cleanup = ( # Code #--------------------------------------------------------------------------# +# =method new +# +# my $cmc = CPAN::Meta::Converter->new( $struct ); +# +# The constructor should be passed a valid metadata structure but invalid +# structures are accepted. If no meta-spec version is provided, version 1.0 will +# be assumed. +# +# =cut sub new { my ($class,$data) = @_; @@ -1198,13 +1250,80 @@ sub new { # create an attributes hash my $self = { 'data' => $data, - 'spec' => $data->{'meta-spec'}{'version'} || "1.0", + 'spec' => _extract_spec_version($data), }; # create the object return bless $self, $class; } +sub _extract_spec_version { + my ($data) = @_; + my $spec = $data->{'meta-spec'}; + + # is meta-spec there and valid? + return "1.0" unless defined $spec && ref $spec eq 'HASH'; # before meta-spec? + + # does the version key look like a valid version? + my $v = $spec->{version}; + if ( defined $v && $v =~ /^\d+(?:\.\d+)?$/ ) { + return $v if defined $v && grep { $v eq $_ } keys %known_specs; # known spec + return $v+0 if defined $v && grep { $v == $_ } keys %known_specs; # 2.0 => 2 + } + + # otherwise, use heuristics: look for 1.x vs 2.0 fields + return "2" if exists $data->{prereqs}; + return "1.4" if exists $data->{configure_requires}; + return "1.2"; # when meta-spec was first defined +} + +# =method convert +# +# my $new_struct = $cmc->convert( version => "2" ); +# +# Returns a new hash reference with the metadata converted to a different form. +# C<convert> will die if any conversion/standardization still results in an +# invalid structure. +# +# Valid parameters include: +# +# =over +# +# =item * +# +# C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2"). +# Defaults to the latest version of the CPAN Meta Spec. +# +# =back +# +# Conversion proceeds through each version in turn. For example, a version 1.2 +# structure might be converted to 1.3 then 1.4 then finally to version 2. The +# conversion process attempts to clean-up simple errors and standardize data. +# For example, if C<author> is given as a scalar, it will converted to an array +# reference containing the item. (Converting a structure to its own version will +# also clean-up and standardize.) +# +# When data are cleaned and standardized, missing or invalid fields will be +# replaced with sensible defaults when possible. This may be lossy or imprecise. +# For example, some badly structured META.yml files on CPAN have prerequisite +# modules listed as both keys and values: +# +# requires => { 'Foo::Bar' => 'Bam::Baz' } +# +# These would be split and each converted to a prerequisite with a minimum +# version of zero. +# +# When some mandatory fields are missing or invalid, the conversion will attempt +# to provide a sensible default or will fill them with a value of 'unknown'. For +# example a missing or unrecognized C<license> field will result in a C<license> +# field of 'unknown'. Fields that may get an 'unknown' include: +# +# =for :list +# * abstract +# * author +# * license +# +# =cut sub convert { my ($self, %args) = @_; @@ -1260,17 +1379,19 @@ sub convert { # ABSTRACT: Convert CPAN distribution metadata structures - +__END__ =pod +=encoding UTF-8 + =head1 NAME CPAN::Meta::Converter - Convert CPAN distribution metadata structures =head1 VERSION -version 2.120921 +version 2.140640 =head1 SYNOPSIS @@ -1386,8 +1507,3 @@ This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut - - -__END__ - - |