This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update CPAN-Meta to CPAN version 2.141170
[perl5.git] / cpan / CPAN-Meta / lib / CPAN / Meta / Converter.pm
index 1bb4431..4917753 100644 (file)
@@ -2,31 +2,30 @@ use 5.006;
 use strict;
 use warnings;
 package CPAN::Meta::Converter;
-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
+our $VERSION = '2.141170'; # VERSION
+
+#pod =head1 SYNOPSIS
+#pod
+#pod   my $struct = decode_json_file('META.json');
+#pod
+#pod   my $cmc = CPAN::Meta::Converter->new( $struct );
+#pod
+#pod   my $new_struct = $cmc->convert( version => "2" );
+#pod
+#pod =head1 DESCRIPTION
+#pod
+#pod This module converts CPAN Meta structures from one form to another.  The
+#pod primary use is to convert older structures to the most modern version of
+#pod the specification, but other transformations may be implemented in the
+#pod future as needed.  (E.g. stripping all custom fields or stripping all
+#pod optional fields.)
+#pod
+#pod =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;
@@ -36,12 +35,14 @@ sub _dclone {
   # right thing for typical things that might be there, like version objects,
   # Path::Class objects, etc.
   no warnings 'once';
-  local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
-
-  my $backend = Parse::CPAN::Meta->json_backend();
-  return $backend->new->utf8->decode(
-    $backend->new->utf8->allow_blessed->convert_blessed->encode($ref)
-  );
+  no warnings 'redefine';
+  local *UNIVERSAL::TO_JSON = sub { "$_[0]" };
+
+  my $json = Parse::CPAN::Meta->json_backend()->new
+      ->utf8
+      ->allow_blessed
+      ->convert_blessed;
+  $json->decode($json->encode($ref))
 }
 
 my %known_specs = (
@@ -247,11 +248,11 @@ sub _downgrade_license {
   }
   elsif( ref $element eq 'ARRAY' ) {
     if ( @$element > 1) {
-      if ( all { $is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element ) {
-        return 'open_source';
+      if (grep { !$is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element) {
+        return 'unknown';
       }
       else {
-        return 'unknown';
+        return 'open_source';
       }
     }
     elsif ( @$element == 1 ) {
@@ -682,7 +683,7 @@ sub _resources_1_2 {
   my (undef, undef, $meta) = @_;
   my $resources = $meta->{resources} || {};
   if ( $meta->{license_url} && ! $resources->{license} ) {
-    $resources->{license} = $meta->license_url
+    $resources->{license} = $meta->{license_url}
       if _is_urlish($meta->{license_url});
   }
   return unless keys %$resources;
@@ -1230,27 +1231,80 @@ my %cleanup = (
   },
 );
 
+# for a given field in a spec version, what fields will it feed
+# into in the *latest* spec (i.e. v2); meta-spec omitted because
+# we always expect a meta-spec to be generated
+my %fragments_generate = (
+  '2' => {
+    'abstract'            =>   'abstract',
+    'author'              =>   'author',
+    'generated_by'        =>   'generated_by',
+    'license'             =>   'license',
+    'name'                =>   'name',
+    'version'             =>   'version',
+    'dynamic_config'      =>   'dynamic_config',
+    'release_status'      =>   'release_status',
+    'keywords'            =>   'keywords',
+    'no_index'            =>   'no_index',
+    'optional_features'   =>   'optional_features',
+    'provides'            =>   'provides',
+    'resources'           =>   'resources',
+    'description'         =>   'description',
+    'prereqs'             =>   'prereqs',
+  },
+  '1.4' => {
+    'abstract'            => 'abstract',
+    'author'              => 'author',
+    'generated_by'        => 'generated_by',
+    'license'             => 'license',
+    'name'                => 'name',
+    'version'             => 'version',
+    'build_requires'      => 'prereqs',
+    'conflicts'           => 'prereqs',
+    'distribution_type'   => 'distribution_type',
+    'dynamic_config'      => 'dynamic_config',
+    'keywords'            => 'keywords',
+    'no_index'            => 'no_index',
+    'optional_features'   => 'optional_features',
+    'provides'            => 'provides',
+    'recommends'          => 'prereqs',
+    'requires'            => 'prereqs',
+    'resources'           => 'resources',
+    'configure_requires'  => 'prereqs',
+  },
+);
+# this is not quite true but will work well enough
+# as 1.4 is a superset of earlier ones
+$fragments_generate{$_} = $fragments_generate{'1.4'} for qw/1.3 1.2 1.1 1.0/;
+
 #--------------------------------------------------------------------------#
 # 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
+#pod =method new
+#pod
+#pod   my $cmc = CPAN::Meta::Converter->new( $struct );
+#pod
+#pod The constructor should be passed a valid metadata structure but invalid
+#pod structures are accepted.  If no meta-spec version is provided, version 1.0 will
+#pod be assumed.
+#pod
+#pod Optionally, you can provide a C<default_version> argument after C<$struct>:
+#pod
+#pod   my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" );
+#pod
+#pod This is only needed when converting a metadata fragment that does not include a
+#pod C<meta-spec> field.
+#pod
+#pod =cut
 
 sub new {
-  my ($class,$data) = @_;
+  my ($class,$data,%args) = @_;
 
   # create an attributes hash
   my $self = {
     'data'    => $data,
-    'spec'    => _extract_spec_version($data),
+    'spec'    => _extract_spec_version($data, $args{default_version}),
   };
 
   # create the object
@@ -1258,11 +1312,11 @@ sub new {
 }
 
 sub _extract_spec_version {
-    my ($data) = @_;
+    my ($data, $default) = @_;
     my $spec = $data->{'meta-spec'};
 
     # is meta-spec there and valid?
-    return "1.0" unless defined $spec && ref $spec eq 'HASH'; # before meta-spec?
+    return( $default || "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};
@@ -1274,56 +1328,56 @@ sub _extract_spec_version {
     # 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
+    return( $default || "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
+#pod =method convert
+#pod
+#pod   my $new_struct = $cmc->convert( version => "2" );
+#pod
+#pod Returns a new hash reference with the metadata converted to a different form.
+#pod C<convert> will die if any conversion/standardization still results in an
+#pod invalid structure.
+#pod
+#pod Valid parameters include:
+#pod
+#pod =over
+#pod
+#pod =item *
+#pod
+#pod C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
+#pod Defaults to the latest version of the CPAN Meta Spec.
+#pod
+#pod =back
+#pod
+#pod Conversion proceeds through each version in turn.  For example, a version 1.2
+#pod structure might be converted to 1.3 then 1.4 then finally to version 2. The
+#pod conversion process attempts to clean-up simple errors and standardize data.
+#pod For example, if C<author> is given as a scalar, it will converted to an array
+#pod reference containing the item. (Converting a structure to its own version will
+#pod also clean-up and standardize.)
+#pod
+#pod When data are cleaned and standardized, missing or invalid fields will be
+#pod replaced with sensible defaults when possible.  This may be lossy or imprecise.
+#pod For example, some badly structured META.yml files on CPAN have prerequisite
+#pod modules listed as both keys and values:
+#pod
+#pod   requires => { 'Foo::Bar' => 'Bam::Baz' }
+#pod
+#pod These would be split and each converted to a prerequisite with a minimum
+#pod version of zero.
+#pod
+#pod When some mandatory fields are missing or invalid, the conversion will attempt
+#pod to provide a sensible default or will fill them with a value of 'unknown'.  For
+#pod example a missing or unrecognized C<license> field will result in a C<license>
+#pod field of 'unknown'.  Fields that may get an 'unknown' include:
+#pod
+#pod =for :list
+#pod * abstract
+#pod * author
+#pod * license
+#pod
+#pod =cut
 
 sub convert {
   my ($self, %args) = @_;
@@ -1336,10 +1390,12 @@ sub convert {
 
   if ( $old_version == $new_version ) {
     $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
-    my $cmv = CPAN::Meta::Validator->new( $converted );
-    unless ( $cmv->is_valid ) {
-      my $errs = join("\n", $cmv->errors);
-      die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
+    unless ( $args->{no_validation} ) {
+      my $cmv = CPAN::Meta::Validator->new( $converted );
+      unless ( $cmv->is_valid ) {
+        my $errs = join("\n", $cmv->errors);
+        die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
+      }
     }
     return $converted;
   }
@@ -1350,10 +1406,12 @@ sub convert {
       last if $vers[$i+1] < $new_version;
       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
       $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
-      my $cmv = CPAN::Meta::Validator->new( $converted );
-      unless ( $cmv->is_valid ) {
-        my $errs = join("\n", $cmv->errors);
-        die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+      unless ( $args->{no_validation} ) {
+        my $cmv = CPAN::Meta::Validator->new( $converted );
+        unless ( $cmv->is_valid ) {
+          my $errs = join("\n", $cmv->errors);
+          die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+        }
       }
     }
     return $converted;
@@ -1365,22 +1423,48 @@ sub convert {
       last if $vers[$i+1] > $new_version;
       my $spec_string = "$vers[$i+1]-from-$vers[$i]";
       $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
-      my $cmv = CPAN::Meta::Validator->new( $converted );
-      unless ( $cmv->is_valid ) {
-        my $errs = join("\n", $cmv->errors);
-        die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+      unless ( $args->{no_validation} ) {
+        my $cmv = CPAN::Meta::Validator->new( $converted );
+        unless ( $cmv->is_valid ) {
+          my $errs = join("\n", $cmv->errors);
+          die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
+        }
       }
     }
     return $converted;
   }
 }
 
+#pod =method upgrade_fragment
+#pod
+#pod   my $new_struct = $cmc->upgrade_fragment;
+#pod
+#pod Returns a new hash reference with the metadata converted to the latest version
+#pod of the CPAN Meta Spec.  No validation is done on the result -- you must
+#pod validate after merging fragments into a complete metadata document.
+#pod
+#pod =cut
+
+sub upgrade_fragment {
+  my ($self) = @_;
+  my ($old_version) = $self->{spec};
+  my %expected =
+    map {; $_ => 1 }
+    grep { defined }
+    map { $fragments_generate{$old_version}{$_} }
+    keys %{ $self->{data} };
+  my $converted = $self->convert( version => $HIGHEST, no_validation => 1 );
+  for my $key ( keys %$converted ) {
+    next if $key =~ /^x_/i || $key eq 'meta-spec';
+    delete $converted->{$key} unless $expected{$key};
+  }
+  return $converted;
+}
+
 1;
 
 # ABSTRACT: Convert CPAN distribution metadata structures
 
-__END__
-
 =pod
 
 =encoding UTF-8
@@ -1391,7 +1475,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures
 
 =head1 VERSION
 
-version 2.140640
+version 2.141170
 
 =head1 SYNOPSIS
 
@@ -1419,6 +1503,13 @@ 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.
 
+Optionally, you can provide a C<default_version> argument after C<$struct>:
+
+  my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" );
+
+This is only needed when converting a metadata fragment that does not include a
+C<meta-spec> field.
+
 =head2 convert
 
   my $new_struct = $cmc->convert( version => "2" );
@@ -1476,6 +1567,14 @@ license
 
 =back
 
+=head2 upgrade_fragment
+
+  my $new_struct = $cmc->upgrade_fragment;
+
+Returns a new hash reference with the metadata converted to the latest version
+of the CPAN Meta Spec.  No validation is done on the result -- you must
+validate after merging fragments into a complete metadata document.
+
 =head1 BUGS
 
 Please report any bugs or feature using the CPAN Request Tracker.
@@ -1507,3 +1606,8 @@ 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__
+
+
+# vim: ts=2 sts=2 sw=2 et: