path: root/Porting/add-pod-file

#!/usr/bin/perl
use 5.14.0;
use warnings;
use Carp;
use File::Spec;
use Getopt::Long;
use Module::Metadata;
require "./Porting/manifest_lib.pl";

=head1 NAME

add-pod-file - Utility to add new F<pod/*.pod> file to core distribution

=head1 USAGE

After C<make test_prep> has been run, call from top level of Perl 5 core
distribution:

   perl Porting/add-pod-file \
       --stub=<XXX> --section=<Z> --verbose

=head1 DESCRIPTION

This is a program which I<may> be helpful when a committer has to add a new
F<*.pod> file in the F<pod/> directory.

=head2 Prerequisites

This program assumes that committer has taken the following steps (in the
order listed):

=over 4

=item 1 You have run F<make test_prep>.

This is to guarantee that all files are properly positioned.

=item 2 You have placed a well-formatted F<.pod> file into the F<pod/> directory.

In the C<NAME> section of this file there is a single non-blank line which
consists of a string in the format C<STUB - ABSTRACT>, where C<STUB> is the
basename of the file without the C<.pod> suffix and C<ABSTRACT> is the short
description of the file.  For example, a new file whose path is
F<pod/perlphonypod.pod> must have a C<NAME> section like this:

    =head1 NAME

    perlphonypod - This is phony POD

=back

F<pod/*.pod> files need entries in multiple locations to keep F<make
test_porting> happy.  This program automates the formulation of I<most> of
those entries, but will need some assistance from the committer to work
properly.  The committer will have to make a reasonable choice as to which
section of F<pod/perl.pod> the new F<.pod> file should be listed under.
The eligible sections are shown in the following table:

    Command-Line Value      Section in pod/perl.pod

         O               => 'Overview',
         T               => 'Tutorials',
         R               => 'Reference Manual',
         I               => 'Internals and C Language Interface',
         H               => 'History',
         M               => 'Miscellaneous',
         L               => 'Language-Specific',
         P               => 'Platform-Specific',

For a first pass, we'll put the new entry at the end of the C<^=head2> section
specified by the committer with the single-initial provided for command-line
switch C<section>.

=head2 Testing this program

=over 4

=item 1 Run F<configure> and F<make> in the source tree.

=item 2 Create a well formatted F<.pod> file somewhere on your system.

=item 3 Copy it into the source tree under F<pod>.

=item 4 Call the program as in L</USAGE> above.

=item 5 Call F<git diff> and examine results.

=item 6 Run F<make test_porting>.

=back

=head1 BUGS

When the argument provided to the C<--section> command-line switch is C<P> (for platform-specific), F<win32/pod.mak> is not getting updated -- but it's not clear whether it I<ought> to be updated.

=cut

my @man_sections = (
    O   => 'Overview',
    T   => 'Tutorials',
    R   => 'Reference Manual',
    I   => 'Internals and C Language Interface',
    H   => 'History',
    M   => 'Miscellaneous',
    L   => 'Language-Specific',
    P   => 'Platform-Specific',
);

my @man_section_abbrevs = ();
my $man_sections_str = '';
for (my $i=0; $i<= $#man_sections; $i+=2) {
    my $j = $i+1;
    push @man_section_abbrevs, $man_sections[$i];
    $man_sections_str .= "\t$man_sections[$i] => $man_sections[$j]\n";
}
my %man_sections_seen = map { $_ => 1 } @man_section_abbrevs;
my $man_sections = { @man_sections };

my ($stub, $section, $verbose) = ('') x 3;
GetOptions(
    "stub=s"        => \$stub,
    "section=s"     => \$section,
    "verbose"       => \$verbose,
) or croak("Error in command line arguments to add-pod-file.pl\n");
croak "$0: Must provide value for command-line switch 'stub'"
    unless length($stub);
croak "$0: Must provide value for command-line switch 'section'"
    unless length($section);
my $section_croak = "$0: Value for command-line switch must be one of @man_section_abbrevs\n";
$section_croak .= "    Select one initial from:\n$man_sections_str";
croak $section_croak unless $man_sections_seen{$section};

my $newpodfile = "$stub.pod";
my $newpodpath = File::Spec->catfile('pod', $newpodfile);
croak "Unable to locate new file '$newpodpath'" unless -f $newpodpath;
my $thispodchecker = File::Spec->catfile(qw|cpan Pod-Checker podchecker|);
croak "Cannot locate 'podchecker' within this checkout; have you called 'make'?"
    unless -f $thispodchecker;

say "Step 1: Basic test of validity of POD in $newpodpath" if $verbose;

system(qq|$^X $thispodchecker $newpodpath|)
    and croak "$newpodpath has POD errors; correct before proceeding further";
my $data = Module::Metadata->new_from_file($newpodpath, collect_pod => 1, decode_pod => 1);

my $regex = qr/\A\s*(?:\S+\s+)+?-+\s+(.+?)\s*\z/s;
my ($abstract) = ($data->pod('NAME') // '')  =~ $regex
    or croak "Could not parse abstract from `=head1 NAME` in $newpodpath";

system(qq|git add $newpodpath|) and croak "Unable to 'git add'";

# Step 2:  Insert entry for $newpodpath into MANIFEST

my $manifest = 'MANIFEST';
say "Step 2: Insert entry for $newpodpath into $manifest" if $verbose;

open(my $IN, '<', $manifest)
    or croak "Can't open $manifest for reading";
my @manifest_orig = <$IN>;
close($IN) or croak "Can't close $manifest after reading";
chomp(@manifest_orig);

my (@before_pod, @pod, @after_pod);
my $seen_pod = 0;
while (my $l = shift(@manifest_orig)) {
    if (! $seen_pod and $l !~ m{^pod\/}) {
        push @before_pod, $l;
    }
    elsif ($l =~ m{^pod\/}) {
        push @pod, $l;
        $seen_pod++;
    }
    else {
        push @after_pod, $l;
    }
}

say "Inserting entry for '$newpodpath' into $manifest; text will be '$abstract'" if $verbose;
my $new_manifest_entry = "$newpodpath\t\t$abstract";
my @new_pod = sort_manifest(@pod, $new_manifest_entry);

open(my $OUT, '>', $manifest)
    or croak "Can't open $manifest for writing";
binmode($OUT);
say $OUT join("\n", @before_pod, @new_pod, @after_pod);
close($OUT) or croak "Can't close $manifest after writing";

my $perlpod = File::Spec->catfile(qw|pod perl.pod|);

say "Step 3: Add entry to $perlpod" if $verbose;

# Read the existing pod/perl.pod into memory.
# Divide it into chunks before the selected section, the head2 of the selected
# section, the selected section, and what comes after the selected section.
# Add the stub and abstract for the new .pod file to the end of the selected
# section.  (Manually reposition to taste.)

open(my $IN1, '<', $perlpod)
    or croak "Can't open $perlpod for reading";
my $perlpod_str;
{
    local $/;
    $perlpod_str = <$IN1>;
}
close($IN1) or croak "Can't close $perlpod after reading";

my $section_head = "=head2 $man_sections->{$section}";
my @chunks = split $section_head, $perlpod_str;
chomp $chunks[0]; # So we can use 'say' consistently later on

my @balance = split /\n/, $chunks[1];
shift @balance; # $chunks[1] begins with a newline which we won't need to output
my (@target_section, @after_section);

my $target = \@target_section;
for my $l (@balance) {
    $target = \@after_section if $l =~ m/^=(head2|for)/;
    push @$target, $l;
}

push @target_section, "    $stub\t\t$abstract";

open(my $OUT1, '>', $perlpod)
    or croak "Can't open $perlpod for writing";
say $OUT1 $chunks[0];
say $OUT1 $section_head;
say $OUT1 join("\n" => @target_section), "\n";
say $OUT1 join("\n" => @after_section), "\n";
close $OUT1 or croak "Can't close $perlpod after writing";

my $podmak_command = './perl -Ilib Porting/pod_rules.pl --build-podmak --verbose';
say "Step 4: Running '$podmak_command' to update win32/pod.mak."
    if $verbose;

system($podmak_command) and croak "'$podmak_command' failed";

system(qq|git add MANIFEST pod/perl.pod win32/pod.mak|)
    and croak "Unable to git-add three updated files";

if ($verbose) {
    say "Call 'git diff --staged' and inspect modified files; correct as needed.";
    say "Then run 'make test_porting'.";
    say "Then say 'git commit'.";
}