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