#!./perl -w
# this script must be run by the current perl to get perl's version right
#
-# Create a META.yml file in the current directory. Must be run from the
+# Create META.yml and META.json files in the current directory. Must be run from the
# root directory of a perl source tree.
use strict;
use warnings;
-use lib "Porting";
+use Getopt::Std;
-use File::Basename qw( dirname );
+my $opts = {
+ 'META.yml' => { version => '1.4' },
+ 'META.json' => { version => '2' },
+};
+my %switches;
+getopts('byj', \%switches);
-BEGIN {
- # Get function prototypes
- require 'regen_lib.pl';
+my @metafiles;
+if ( $switches{y} ) {
+ push @metafiles, 'META.yml';
+}
+elsif ( $switches{j} ) {
+ push @metafiles, 'META.json';
+}
+else {
+ push @metafiles, keys %$opts;
}
+my ($vers, $stat ) = _determine_status();
+
+my $distmeta = {
+ 'version' => $vers,
+ 'name' => 'perl',
+ 'author' => [
+ 'perl5-porters@perl.org'
+ ],
+ 'license' => [
+ 'perl_5'
+ ],
+ 'abstract' => 'The Perl 5 language interpreter',
+ 'release_status' => $stat,
+ 'dynamic_config' => 1,
+ 'resources' => {
+ 'repository' => {
+ 'url' => 'http://perl5.git.perl.org/'
+ },
+ 'homepage' => 'http://www.perl.org/',
+ 'bugtracker' => {
+ 'web' => 'https://rt.perl.org/'
+ },
+ 'license' => [
+ 'http://dev.perl.org/licenses/'
+ ],
+ },
+};
-my $file = "META.yml";
-my $new_file = "META.yml-new";
+use lib "Porting";
+use File::Basename qw( dirname );
+use CPAN::Meta;
+
+BEGIN {
+ # Get function prototypes
+ require 'regen/regen_lib.pl';
+}
use Maintainers qw(%Modules get_module_files get_module_pat);
my @CPAN = grep { $Modules{$_}{CPAN} } keys %Modules;
-my @files = ('lib/unicore/mktables', 'TestInit.pm',
- 'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
- map { get_module_files($_) } @CPAN);
-my @dirs = ('cpan', 'win32', grep { -d $_ && $_ !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
+my @files = ('autodoc.pl', 'lib/unicore/mktables', 'TestInit.pm',
+ 'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
+ map { get_module_files($_) } @CPAN);
+my @dirs = ('cpan', 'win32', 'lib/perl5db', grep { -d $_ && $_ !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
my %dirs;
@dirs{@dirs} = ();
-my $files = join '', map { " - $_\n" }
+@files =
grep {
my $d = $_;
+ my $previous_d = '';
while(($d = dirname($d)) ne "."){
+ last if $d eq $previous_d; # safety valve
last if exists $dirs{$d};
+ $previous_d = $d;
}
# if $d is "." it means we tried every parent dir of the file and none
# of them were in the private list
-
- $d eq ".";
+
+ $d eq "." || $d eq $previous_d;
}
sort { lc $a cmp lc $b } @files;
-my $dirs = join '', map { " - $_\n" } sort { lc $a cmp lc $b } @dirs;
-
-my $fh = safer_open($new_file);
-
-print $fh <<"EOI";
-name: perl
-version: $]
-abstract: The Perl language interpreter
-author: perl5-porters\@perl.org
-license: perl
-resources:
- homepage: http://www.perl.org/
- bugtracker: http://rt.perl.org/perlbug/
- license: http://dev.perl.org/licenses/
- repository: http://perl5.git.perl.org/
-distribution_type: core
-generated_by: $0
-no_index:
- directory:
-$dirs
- file:
-$files
-EOI
-
-safer_close($fh);
-rename_if_different($new_file, $file);
+@dirs = sort { lc $a cmp lc $b } @dirs;
+
+$distmeta->{no_index}->{file} = \@files;
+$distmeta->{no_index}->{directory} = \@dirs;
+my $meta = CPAN::Meta->create( $distmeta );
+foreach my $file ( @metafiles ) {
+ my $fh = open_new($file);
+ print $fh $meta->as_string( $opts->{$file} );
+ close_and_rename($fh);
+}
+exit 0;
+
+sub _determine_status {
+ my $patchlevel_h = 'patchlevel.h';
+ return unless -e $patchlevel_h;
+ my $status = '';
+ my $version = '';
+ {
+ my %defines;
+ open my $fh, '<', $patchlevel_h;
+ my @vers;
+ while (<$fh>) {
+ chomp;
+ next unless m!^#define! or m!!;
+ if ( m!^#define! ) {
+ my ($foo,$bar) = ( split /\s+/ )[1,2];
+ $defines{$foo} = $bar;
+ }
+ elsif ( m!\"RC\d+\"! ) {
+ $status = 'testing';
+ last;
+ }
+ }
+ unless ( $status ) {
+ $status = $defines{PERL_VERSION} % 2 ? 'unstable' : 'stable';
+ }
+ if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_SUBVERSION) ) {
+ $version = sprintf '%d.%03d%03d', map { $defines{$_} } @wotsits;
+ }
+ else {
+ # Well, you never know
+ $version = sprintf '5.%03d_%02d', map { $defines{$_} } qw(PATCHLEVEL SUBVERSION);
+ }
+ }
+ return ( $version, $status );
+}