makemeta revision 1.4 
1#!./perl -w
2# this script must be run by the current perl to get perl's version right
3#
4# Create META.yml and META.json files in the current directory. Must be run from the
5# root directory of a perl source tree.
6
7use strict;
8use warnings;
9use Getopt::Std;
10
11# avoid unnecessary churn in x_serialization_backend in META.*
12$ENV{PERL_JSON_BACKEND} = $ENV{CPAN_META_JSON_BACKEND} = 'JSON::PP';
13$ENV{PERL_YAML_BACKEND} = 'CPAN::Meta::YAML';
14
15my $opts = {
16  'META.yml'  => { version => '1.4' },
17  'META.json' => { version => '2' },
18};
19
20my %switches;
21getopts('byj', \%switches);
22
23my @metafiles;
24if ( $switches{y} ) {
25  push @metafiles, 'META.yml';
26}
27elsif ( $switches{j} ) {
28  push @metafiles, 'META.json';
29}
30else {
31  push @metafiles, keys %$opts;
32}
33
34my ($vers, $stat ) = _determine_status();
35
36my $distmeta = {
37  'version' => $vers,
38  'name' => 'perl',
39  'author' => [
40    'perl5-porters@perl.org'
41  ],
42  'license' => [
43    'perl_5'
44  ],
45  'abstract' => 'The Perl 5 language interpreter',
46  'release_status' => $stat,
47  'dynamic_config' => 1,
48  'resources' => {
49    'repository' => {
50      'url' => 'https://github.com/Perl/perl5'
51    },
52    'homepage' => 'http://www.perl.org/',
53    'bugtracker' => {
54      'web' => 'https://github.com/Perl/perl5/issues'
55    },
56    'license' => [
57      'http://dev.perl.org/licenses/'
58    ],
59  },
60};
61
62use lib "Porting";
63use File::Basename qw( dirname );
64use CPAN::Meta;
65
66BEGIN {
67    # Get function prototypes
68    require './regen/regen_lib.pl';
69}
70
71use Maintainers qw(%Modules get_module_files get_module_pat);
72
73my @CPAN  = grep { $Modules{$_}{CPAN} } keys %Modules;
74my @files = ('autodoc.pl', 'lib/unicore/mktables', 'TestInit.pm',
75             'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
76             map { get_module_files($_) } @CPAN);
77my @dirs  = ('cpan', 'win32', 'lib/perl5db', grep { -d $_ && $_  !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
78
79my %dirs;
80@dirs{@dirs} = ();
81
82@files =
83  grep {
84    my $d = $_;
85    my $previous_d = '';
86    while(($d = dirname($d)) ne "."){
87      last if $d eq $previous_d; # safety valve
88      last if exists $dirs{$d};
89      $previous_d = $d;
90    }
91
92    # if $d is "." it means we tried every parent dir of the file and none
93    # of them were in the private list
94
95    $d eq "." || $d eq $previous_d;
96  }
97  sort { lc $a cmp lc $b } @files;
98
99@dirs  = sort { lc $a cmp lc $b } @dirs;
100
101$distmeta->{no_index}->{file} = \@files;
102$distmeta->{no_index}->{directory} = \@dirs;
103
104my $meta = CPAN::Meta->create( $distmeta );
105foreach my $file ( @metafiles ) {
106  my $fh = open_new($file);
107  print $fh $meta->as_string( $opts->{$file} );
108  close_and_rename($fh);
109}
110exit 0;
111
112sub _determine_status {
113  my $patchlevel_h = 'patchlevel.h';
114  return unless -e $patchlevel_h;
115  my $status = '';
116  my $version = '';
117  {
118    my %defines;
119    open my $fh, '<', $patchlevel_h;
120    my @vers;
121    while (<$fh>) {
122      chomp;
123      next unless m!^#define! or m!!;
124      if ( m!^#define! ) {
125        my ($foo,$bar) = ( split /\s+/ )[1,2];
126        $defines{$foo} = $bar;
127      }
128      elsif ( m!\"RC\d+\"! ) {
129        $status = 'testing';
130        last;
131      }
132    }
133    unless ( $status ) {
134      $status = $defines{PERL_VERSION} % 2 ? 'unstable' : 'stable';
135    }
136    if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_SUBVERSION) ) {
137      $version = sprintf '%d.%03d%03d', map { $defines{$_} } @wotsits;
138    }
139    else {
140      # Well, you never know
141      $version = sprintf '5.%03d_%02d', map { $defines{$_} } qw(PATCHLEVEL SUBVERSION);
142    }
143  }
144  return ( $version, $status );
145}
146