bisect-runner.pl: Reword some pod examples

[perl5.git] / Porting / makemeta

#!./perl -w
# this script must be run by the current perl to get perl's version right
#
# 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;

my $opts = {
  'META.yml'  => { version => '1.4' },
  'META.json' => { version => '2' },
};

my $file = shift;
die "Must specify META.yml or META.json" unless $file and defined $opts->{$file};

my $status = _determine_status();

my $distmeta = {
  'version' => $],
  'name' => 'perl',
  'author' => [
    'perl5-porters@perl.org'
  ],
  'license' => [
    'perl_5'
  ],
  'abstract' => 'The Perl 5 language interpreter',
  'release_status' => $status,
  'dynamic_config' => 1,
  'resources' => {
    'repository' => {
      'url' => 'http://perl5.git.perl.org/'
    },
    'homepage' => 'http://www.perl.org/',
    'bugtracker' => {
      'web' => 'http://rt.perl.org/perlbug/'
    },
    'license' => [
      'http://dev.perl.org/licenses/'
    ],
  },
};

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 = ('autodoc.pl', 'lib/unicore/mktables', 'TestInit.pm',
             'Porting/Maintainers.pm', 'Porting/perldelta_template.pod',
             map { get_module_files($_) } @CPAN);
my @dirs  = ('cpan', 'win32', 'mad', grep { -d $_ && $_  !~ /^cpan/ } map { get_module_pat($_) } @CPAN);

my %dirs;
@dirs{@dirs} = ();

@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 $previous_d;
  }
  sort { lc $a cmp lc $b } @files;

@dirs  = sort { lc $a cmp lc $b } @dirs;

$distmeta->{no_index}->{file} = \@files;
$distmeta->{no_index}->{directory} = \@dirs;

my $meta = CPAN::Meta->create( $distmeta );
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 %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';
    }
  }
  return $status;
}