Add support for META.json and MYMETA.json

We now use CPAN::Meta to generate version 2 CPAN Meta files (JSON format) as well as version 1.4 Meta files (YAML format). This does not add support for version 2 metadata features; instead the existing version 1.4 metadata is upconverted to version 2.
FROGGS · Feb 3, 2011 · 51426c1 · 51426c1
1 parent 5062d92
commit 51426c1
Show file tree

Hide file tree

Showing 6 changed files with 188 additions and 79 deletions.
diff --git a/.gitignore b/.gitignore
@@ -13,8 +13,8 @@
 /cover_db
 /pm_to_blib
 /PM_to_blib
-/META.yml
-/MYMETA.yml
+/META.*
+/MYMETA.*
 /*.tar.gz
 /Module-Build-*
 /LICENSE

diff --git a/Build.PL b/Build.PL
@@ -33,6 +33,7 @@ my $build = ModuleBuildBuilder->new(
     'File::Temp'            => 0.15,    # tmpdir() + fixes
     'Test::More'            => 0.49,
     'Test::Harness'         => 3.16,    # PERL5LIB fixes
+    'Parse::CPAN::Meta'     => '1.420',
   },
   # We have to provide a boostrap copy in case configure_requires
   # is not respected, but let's try to let people do it the right way
@@ -63,7 +64,7 @@ my $build = ModuleBuildBuilder->new(
     'Text::ParseWords'      => 0,
     'Getopt::Long'          => 0,
     'Test::Harness'         => 0,
-    'CPAN::Meta::YAML'      => 0.002,
+    'CPAN::Meta'            => '2.110330',
     # configure_requires repeated here
     'Perl::OSType'          => 1, # needs 1.0 API
     'version'               => 0.87,  # No longer requires M::B
@@ -138,7 +139,7 @@ my $build = ModuleBuildBuilder->new(
 );
 
 $build->create_build_script;
-if (-f "META.yml" && ! -f "MYMETA.yml") { # fallback if we don't have CPAN::Meta::YAML
+if (-f "META.yml" && ! -f "MYMETA.yml") { # fallback if we don't have CPAN::Meta
   require File::Copy;
   File::Copy::copy("META.yml", "MYMETA.yml") or warn "Error: $!\n";
   if ( -f 'MYMETA.yml' ) {

diff --git a/MANIFEST b/MANIFEST
@@ -96,3 +96,4 @@ t/use_tap_harness.t
 t/versions.t
 t/write_default_maniskip.t
 t/xs.t
+META.json
diff --git a/lib/Module/Build/Base.pm b/lib/Module/Build/Base.pm
@@ -902,10 +902,13 @@ __PACKAGE__->add_property(build_bat => 0);
 __PACKAGE__->add_property(bundle_inc => []);
 __PACKAGE__->add_property(bundle_inc_preload => []);
 __PACKAGE__->add_property(config_dir => '_build');
+__PACKAGE__->add_property(dynamic_config => 1);
 __PACKAGE__->add_property(include_dirs => []);
 __PACKAGE__->add_property(license => 'unknown');
 __PACKAGE__->add_property(metafile => 'META.yml');
 __PACKAGE__->add_property(mymetafile => 'MYMETA.yml');
+__PACKAGE__->add_property(metafile2 => 'META.json');
+__PACKAGE__->add_property(mymetafile2 => 'MYMETA.json');
 __PACKAGE__->add_property(recurse_into => []);
 __PACKAGE__->add_property(use_rcfile => 1);
 __PACKAGE__->add_property(create_packlist => 1);
@@ -1876,39 +1879,72 @@ EOF
 
 sub create_mymeta {
   my ($self) = @_;
-  my $mymetafile = $self->mymetafile;
-  my $metafile = $self->metafile;
 
-  # cleanup
-  if ( $self->delete_filetree($mymetafile) ) {
-    $self->log_verbose("Removed previous '$mymetafile'\n");
+  my ($meta_obj, $mymeta);
+  my @metafiles = ( $self->metafile, $self->metafile2 );
+  my @mymetafiles = ( $self->mymetafile, $self->mymetafile2 );
+
+  # cleanup old MYMETA
+  for my $f ( @mymetafiles ) {
+    if ( $self->delete_filetree($f) ) {
+      $self->log_verbose("Removed previous '$f'\n");
+    }
   }
-  $self->log_info("Creating new '$mymetafile' with configuration results\n");
 
-  # use old meta and update prereqs, if possible
-  my $mymeta;
-  if ( -f $metafile ) {
-    $mymeta = eval { $self->read_metafile( $self->metafile ) };
+  # Try loading META.json or META.yml
+  if ( $self->try_require("CPAN::Meta", "2.110330") ) {
+    for my $file ( @metafiles ) {
+      next unless -f $file;
+      $meta_obj = eval { CPAN::Meta->load_file($file) };
+      last if $meta_obj;
+    }
   }
-  # if we read META OK, just update it
+
+  # maybe get a copy in spec v2 format (regardless of original source)
+  $mymeta = $meta_obj->as_struct
+    if $meta_obj;
+
+  # if we have metadata, just update it
   if ( defined $mymeta ) {
     my $prereqs = $self->_normalize_prereqs;
-    for my $t ( 'configure_requires', @{$self->prereq_action_types} ) {
-        $mymeta->{$t} = $prereqs->{$t} if $prereqs->{$t};
+    # XXX refactor this mapping somewhere
+    $mymeta->{prereqs}{runtime}{requires} = $prereqs->{requires};
+    $mymeta->{prereqs}{build}{requires} = $prereqs->{build_requires};
+    $mymeta->{prereqs}{runtime}{recommends} = $prereqs->{recommends};
+    $mymeta->{prereqs}{runtime}{conflicts} = $prereqs->{conflicts};
+    # delete empty entries
+    for my $phase ( keys %{$mymeta->{prereqs}} ) {
+      if ( ref $mymeta->{prereqs}{$phase} eq 'HASH' ) {
+        for my $type ( keys %{$mymeta->{prereqs}{$phase}} ) {
+          if ( ! defined $mymeta->{prereqs}{$phase}{$type}
+            || ! keys %{$mymeta->{prereqs}{$phase}{$type}}
+          ) {
+            delete $mymeta->{prereqs}{$phase}{$type};
+          }
+        }
+      }
+      if ( ! defined $mymeta->{prereqs}{$phase}
+        || ! keys %{$mymeta->{prereqs}{$phase}}
+      ) {
+        delete $mymeta->{prereqs}{$phase};
+      }
     }
+    $mymeta->{dynamic_config} = 0;
+    $mymeta->{generated_by} = "Module::Build version $Module::Build::VERSION";
+    $meta_obj = CPAN::Meta->new( $mymeta );
   }
-  # but generate from scratch, ignoring errors if META doesn't exist
+  # or generate from scratch, ignoring errors if META doesn't exist
   else {
-    $mymeta = $self->get_metadata( fatal => 0 );
+    $meta_obj = $self->_get_meta_object(
+      quiet => 0, dynamic => 0, fatal => 0, auto => 0
+    );
   }
 
-  # MYMETA is always static
-  $mymeta->{dynamic_config} = 0;
-  # Note which M::B created it
-  $mymeta->{generated_by} = "Module::Build version $Module::Build::VERSION";
+  my @created = $self->_write_meta_files( $meta_obj, 'MYMETA' );
+
+  $self->log_warn("Could not create MYMETA files\n")
+    unless @created;
 
-  $self->write_metafile( $mymetafile, $mymeta ) or
-    $self->log_warn("Could not create MYMETA.yml\n");
   return 1;
 }
 
@@ -2977,9 +3013,9 @@ sub find_PL_files {
   }
 
   return unless -d 'lib';
-  return { 
-    map {$_, [/^(.*)\.PL$/i ]} 
-    @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) } 
+  return {
+    map {$_, [/^(.*)\.PL$/i ]}
+    @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) }
   };
 }
 
@@ -3653,7 +3689,7 @@ sub ACTION_realclean {
   $self->depends_on('clean');
   $self->log_info("Cleaning up configuration files\n");
   $self->delete_filetree(
-    $self->config_dir, $self->mymetafile, $self->build_script
+    $self->config_dir, $self->mymetafile, $self->mymetafile2, $self->build_script
   );
 }
 
@@ -3785,9 +3821,12 @@ sub _check_mymeta_skip {
 
   my $mymetafile = $self->mymetafile;
   # we can't check it, just add it anyway to be safe
-  unless ( $skip_factory && $skip_factory->($maniskip)->($mymetafile) ) {
-    $self->log_warn("File '$maniskip' does not include '$mymetafile'. Adding it now.\n");
-    $self->_append_maniskip("^$mymetafile\$", $maniskip);
+  for my $file ( $self->mymetafile, $self->mymetafile2 ) {
+    unless ( $skip_factory && $skip_factory->($maniskip)->($file) ) {
+      $self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n");
+      my $safe = quotemeta($file);
+      $self->_append_maniskip("^$safe\$", $maniskip);
+    }
   }
 }
 
@@ -4455,16 +4494,15 @@ sub do_create_metafile {
   return if $self->{wrote_metadata};
 
   my $p = $self->{properties};
-  my $metafile = $self->metafile;
 
   unless ($p->{license}) {
     $self->log_warn("No license specified, setting license = 'unknown'\n");
     $p->{license} = 'unknown';
   }
 
+  my @metafiles = ( $self->metafile, $self->metafile2 );
   # If we're in the distdir, the metafile may exist and be non-writable.
-  $self->delete_filetree($metafile);
-  $self->log_info("Creating $metafile\n");
+  $self->delete_filetree($_) for @metafiles;
 
   # Since we're building ourself, we have to do some special stuff
   # here: the ConfigData module is found in blib/lib.
@@ -4474,46 +4512,85 @@ sub do_create_metafile {
     push @INC, File::Spec->catdir($self->blib, 'lib');
   }
 
-  if (
-    $self->write_metafile(
-      $self->metafile,$self->get_metadata(fatal=>1, auto => 1)
-    )
-  ){
+  my $meta_obj = $self->_get_meta_object(
+    quiet => 1, fatal => 1, auto => 1
+  );
+  my @created = $self->_write_meta_files( $meta_obj, 'META' );
+  if ( @created ) {
     $self->{wrote_metadata} = 1;
-    $self->_add_to_manifest('MANIFEST', $metafile);
+    $self->_add_to_manifest('MANIFEST', $_) for @created;
   }
-
   return 1;
 }
 
-# We handle slurping from the metafile to ensure proper utf8 if possible
-sub read_metafile {
+sub _write_meta_files {
   my $self = shift;
-  my ($metafile) = @_;
+  my ($meta, $file) = @_;
+  $file =~ s{\.(?:yml|json)$}{};
 
-  return unless $self->try_require("CPAN::Meta::YAML", "0.002");
+  my @created;
+  push @created, "$file\.yml"
+    if $meta && $meta->save( "$file\.yml", {version => "1.4"} );
+  push @created, "$file\.json"
+    if $meta && $meta->save( "$file\.json" );
 
-  my $string = $self->_slurp($metafile, $] < 5.8 ? "" : ":utf8");
-  my $meta = CPAN::Meta::YAML->read_string($string)
-    or $self->log_warn( "Error parsing '$metafile': " . CPAN::Meta::YAML->errstr . "\n");
+  if ( @created ) {
+    $self->log_info("Created " . join(" and ", @created) . "\n");
+  }
+  return @created;
+}
+
+sub _get_meta_object {
+  my $self = shift;
+  my %args = @_;
+  return unless $self->try_require("CPAN::Meta", "2.110330");
+
+  my $meta;
+  eval {
+    my $data = $self->get_metadata(
+      fatal => $args{fatal},
+      auto => $args{auto},
+    );
+    $data->{dynamic_config} = $args{dynamic} if defined $args{dynamic};
+    $meta = CPAN::Meta->create( $data );
+  };
+  if ($@ && ! $args{quiet}) {
+    $self->log_warn(
+      "Could not get valid metadata. Error is: $@\n"
+    );
+  }
 
-  return $meta->[0] || {};
+  return $meta;
 }
 
-# We handle spewing to the metafile to ensure proper utf8 if possible
+# We return a version 1.4 structure for backwards compatibility
+sub read_metafile {
+  my $self = shift;
+  my ($metafile) = @_;
+
+  return unless $self->try_require("CPAN::Meta", "2.110330");
+  my $meta = CPAN::Meta->load_file($metafile);
+  return $meta->as_struct( {version => "1.4"} );
+}
+
+# For legacy compatibility, we upconvert a 1.4 data structure, ensuring
+# validity, and then downconvert it back to save it.
+#
+# generally, this code should no longer be used
 sub write_metafile {
   my $self = shift;
-  my ($metafile, $node) = @_;
+  my ($metafile, $struct) = @_;
 
-  return unless $self->try_require("CPAN::Meta::YAML", "0.002");
+  return unless $self->try_require("CPAN::Meta", "2.110330");
 
-  my $yaml = CPAN::Meta::YAML->new($node);
-  my $string = $yaml->write_string;
-  return $self->_spew($metafile, $string, $] < 5.8 ? "" : ":utf8")
+  my $meta = CPAN::Meta->new( $struct );
+  return $meta->save( $metafile, { version => "1.4" } );
 }
 
 sub normalize_version {
   my ($self, $version) = @_;
+  $version = 0 unless defined $version;
+
   if ( $version =~ /[=<>!,]/ ) { # logic, not just version
     # take as is without modification
   }
@@ -4548,7 +4625,6 @@ sub _normalize_prereqs {
   return \%prereq_types;
 }
 
-
 # wrapper around old prepare_metadata API;
 sub get_metadata {
   my ($self, %args) = @_;