xref: /openbsd/gnu/usr.bin/perl/Porting/makemeta (revision eac174f2) 
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('nbyj', \%switches);
22
23=head1 SYNOPSIS
24
25  ./perl -Ilib Porting/makemeta
26
27=head1 OPTIONS
28
29=item B<-y>
30
31Update only META.yml
32
33The default is to update both, META.yml and META.json
34
35=item B<-n>
36
37Don't update any files, exit with 1 if changes would be made
38
39=item B<-b>
40
41No-op, kept for historical purposes
42
43=cut
44
45my @metafiles;
46if ( $switches{y} ) {
47  push @metafiles, 'META.yml';
48}
49elsif ( $switches{j} ) {
50  push @metafiles, 'META.json';
51}
52else {
53  push @metafiles, keys %$opts;
54}
55
56my ($vers, $stat ) = _determine_status();
57
58my $distmeta = {
59  'version' => $vers,
60  'name' => 'perl',
61  'author' => [
62    'perl5-porters@perl.org'
63  ],
64  'license' => [
65    'perl_5'
66  ],
67  'abstract' => 'The Perl 5 language interpreter',
68  'release_status' => $stat,
69  'dynamic_config' => 1,
70  'resources' => {
71    'repository' => {
72      'url' => 'https://github.com/Perl/perl5'
73    },
74    'homepage' => 'https://www.perl.org/',
75    'bugtracker' => {
76      'web' => 'https://github.com/Perl/perl5/issues'
77    },
78    'license' => [
79      'https://dev.perl.org/licenses/'
80    ],
81  },
82};
83
84use lib "Porting";
85use File::Basename qw( dirname );
86use CPAN::Meta;
87use File::Spec;
88
89BEGIN {
90    # Get function prototypes
91    require './regen/regen_lib.pl';
92}
93
94use Maintainers qw(%Modules get_module_files get_module_pat);
95
96my @CPAN  = grep { $Modules{$_}{CPAN} } keys %Modules;
97my @files = ('autodoc.pl', 'lib/unicore/mktables', 'TestInit.pm',
98             'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
99             map { get_module_files($_) } @CPAN);
100my @extt = map { my $t = File::Spec->catdir($_, "t");
101                 -d $t ? ( $_ . "t" ) : () }
102  grep { /^ext\b/ } split ' ', $Modules{_PERLLIB}{FILES};
103my @dirs  = ('cpan', 'win32', 'lib/perl5db', @extt, grep { -d $_ && $_  !~ /^cpan/ } map { get_module_pat($_) } @CPAN);
104
105my %dirs;
106@dirs{@dirs} = ();
107
108@files =
109  grep {
110    my $d = $_;
111    my $previous_d = '';
112    while(($d = dirname($d)) ne "."){
113      last if $d eq $previous_d; # safety valve
114      last if exists $dirs{$d};
115      $previous_d = $d;
116    }
117
118    # if $d is "." it means we tried every parent dir of the file and none
119    # of them were in the private list
120
121    $d eq "." || $d eq $previous_d;
122  }
123  sort { lc $a cmp lc $b } @files;
124
125@dirs  = sort { lc $a cmp lc $b } @dirs;
126
127$distmeta->{no_index}->{file} = \@files;
128$distmeta->{no_index}->{directory} = \@dirs;
129
130my $meta = CPAN::Meta->create( $distmeta );
131foreach my $file ( @metafiles ) {
132  my $new = $meta->as_string( $opts->{$file} );
133  if( $switches{n} ) {
134    open my $fh, '<:raw', $file;
135    local $/;
136    my $old = <$fh>;
137    if( $old ne $new ) {
138      exit 1;
139    }
140  } else {
141    my $fh = open_new($file);
142    print $fh $new;
143    close_and_rename($fh);
144  }
145}
146exit 0;
147
148sub _determine_status {
149  my $patchlevel_h = 'patchlevel.h';
150  return unless -e $patchlevel_h;
151  my $status = '';
152  my $version = '';
153  {
154    my %defines;
155    open my $fh, '<', $patchlevel_h;
156    my @vers;
157    while (<$fh>) {
158      chomp;
159      next unless m!^#define! or m!!;
160      if ( m!^#define! ) {
161        my ($foo,$bar) = ( split /\s+/ )[1,2];
162        $defines{$foo} = $bar;
163      }
164      elsif ( m!\"RC\d+\"! ) {
165        $status = 'testing';
166        last;
167      }
168    }
169    unless ( $status ) {
170      $status = $defines{PERL_VERSION} % 2 ? 'unstable' : 'stable';
171    }
172    if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_SUBVERSION) ) {
173      $version = sprintf '%d.%03d%03d', map { $defines{$_} } @wotsits;
174    }
175    else {
176      # Well, you never know
177      $version = sprintf '5.%03d_%02d', map { $defines{$_} } qw(PATCHLEVEL SUBVERSION);
178    }
179  }
180  return ( $version, $status );
181}
182