Porting/add-pod-file

   1 #!/usr/bin/perl
   2 use 5.14.0;
   3 use warnings;
   4 use Carp;
   5 use File::Spec;
   6 use Getopt::Long;
   7 use Module::Metadata;
   8 require "./Porting/manifest_lib.pl";
   9
  10 =head1 NAME
  11
  12 add-pod-file - Utility to add new F<pod/*.pod> file to core distribution
  13
  14 =head1 USAGE
  15
  16 After C<make test_prep> has been run, call from top level of Perl 5 core
  17 distribution:
  18
  19    perl Porting/add-pod-file \
  20        --stub=<XXX> --section=<Z> --verbose
  21
  22 =head1 DESCRIPTION
  23
  24 This is a program which I<may> be helpful when a committer has to add a new
  25 F<*.pod> file in the F<pod/> directory.
  26
  27 =head2 Prerequisites
  28
  29 This program assumes that committer has taken the following steps (in the
  30 order listed):
  31
  32 =over 4
  33
  34 =item 1 You have run F<make test_prep>.
  35
  36 This is to guarantee that all files are properly positioned.
  37
  38 =item 2 You have placed a well-formatted F<.pod> file into the F<pod/> directory.
  39
  40 In the C<NAME> section of this file there is a single non-blank line which
  41 consists of a string in the format C<STUB - ABSTRACT>, where C<STUB> is the
  42 basename of the file without the C<.pod> suffix and C<ABSTRACT> is the short
  43 description of the file.  For example, a new file whose path is
  44 F<pod/perlphonypod.pod> must have a C<NAME> section like this:
  45
  46     =head1 NAME
  47
  48     perlphonypod - This is phony POD
  49
  50 =back
  51
  52 F<pod/*.pod> files need entries in multiple locations to keep F<make
  53 test_porting> happy.  This program automates the formulation of I<most> of
  54 those entries, but will need some assistance from the committer to work
  55 properly.  The committer will have to make a reasonable choice as to which
  56 section of F<pod/perl.pod> the new F<.pod> file should be listed under.
  57 The eligible sections are shown in the following table:
  58
  59     Command-Line Value      Section in pod/perl.pod
  60
  61          O               => 'Overview',
  62          T               => 'Tutorials',
  63          R               => 'Reference Manual',
  64          I               => 'Internals and C Language Interface',
  65          H               => 'History',
  66          M               => 'Miscellaneous',
  67          L               => 'Language-Specific',
  68          P               => 'Platform-Specific',
  69
  70 For a first pass, we'll put the new entry at the end of the C<^=head2> section
  71 specified by the committer with the single-initial provided for command-line
  72 switch C<section>.
  73
  74 =head2 Testing this program
  75
  76 =over 4
  77
  78 =item 1 Run F<configure> and F<make> in the source tree.
  79
  80 =item 2 Create a well formatted F<.pod> file somewhere on your system.
  81
  82 =item 3 Copy it into the source tree under F<pod>.
  83
  84 =item 4 Call the program as in L</USAGE> above.
  85
  86 =item 5 Call F<git diff> and examine results.
  87
  88 =item 6 Run F<make test_porting>.
  89
  90 =back
  91
  92 =head1 BUGS
  93
  94 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.
  95
  96 =cut
  97
  98 my @man_sections = (
  99     O   => 'Overview',
 100     T   => 'Tutorials',
 101     R   => 'Reference Manual',
 102     I   => 'Internals and C Language Interface',
 103     H   => 'History',
 104     M   => 'Miscellaneous',
 105     L   => 'Language-Specific',
 106     P   => 'Platform-Specific',
 107 );
 108
 109 my @man_section_abbrevs = ();
 110 my $man_sections_str = '';
 111 for (my $i=0; $i<= $#man_sections; $i+=2) {
 112     my $j = $i+1;
 113     push @man_section_abbrevs, $man_sections[$i];
 114     $man_sections_str .= "\t$man_sections[$i] => $man_sections[$j]\n";
 115 }
 116 my %man_sections_seen = map { $_ => 1 } @man_section_abbrevs;
 117 my $man_sections = { @man_sections };
 118
 119 my ($stub, $section, $verbose) = ('') x 3;
 120 GetOptions(
 121     "stub=s"        => \$stub,
 122     "section=s"     => \$section,
 123     "verbose"       => \$verbose,
 124 ) or croak("Error in command line arguments to add-pod-file.pl\n");
 125 croak "$0: Must provide value for command-line switch 'stub'"
 126     unless length($stub);
 127 croak "$0: Must provide value for command-line switch 'section'"
 128     unless length($section);
 129 my $section_croak = "$0: Value for command-line switch must be one of @man_section_abbrevs\n";
 130 $section_croak .= "    Select one initial from:\n$man_sections_str";
 131 croak $section_croak unless $man_sections_seen{$section};
 132
 133 my $newpodfile = "$stub.pod";
 134 my $newpodpath = File::Spec->catfile('pod', $newpodfile);
 135 croak "Unable to locate new file '$newpodpath'" unless -f $newpodpath;
 136 my $thispodchecker = File::Spec->catfile(qw|cpan Pod-Checker podchecker|);
 137 croak "Cannot locate 'podchecker' within this checkout; have you called 'make'?"
 138     unless -f $thispodchecker;
 139
 140 say "Step 1: Basic test of validity of POD in $newpodpath" if $verbose;
 141
 142 system(qq|$^X $thispodchecker $newpodpath|)
 143     and croak "$newpodpath has POD errors; correct before proceeding further";
 144 my $data = Module::Metadata->new_from_file($newpodpath, collect_pod => 1, decode_pod => 1);
 145
 146 my $regex = qr/\A\s*(?:\S+\s+)+?-+\s+(.+?)\s*\z/s;
 147 my ($abstract) = ($data->pod('NAME') // '')  =~ $regex
 148     or croak "Could not parse abstract from `=head1 NAME` in $newpodpath";
 149
 150 system(qq|git add $newpodpath|) and croak "Unable to 'git add'";
 151
 152 # Step 2:  Insert entry for $newpodpath into MANIFEST
 153
 154 my $manifest = 'MANIFEST';
 155 say "Step 2: Insert entry for $newpodpath into $manifest" if $verbose;
 156
 157 open(my $IN, '<', $manifest)
 158     or croak "Can't open $manifest for reading";
 159 my @manifest_orig = <$IN>;
 160 close($IN) or croak "Can't close $manifest after reading";
 161 chomp(@manifest_orig);
 162
 163 my (@before_pod, @pod, @after_pod);
 164 my $seen_pod = 0;
 165 while (my $l = shift(@manifest_orig)) {
 166     if (! $seen_pod and $l !~ m{^pod\/}) {
 167         push @before_pod, $l;
 168     }
 169     elsif ($l =~ m{^pod\/}) {
 170         push @pod, $l;
 171         $seen_pod++;
 172     }
 173     else {
 174         push @after_pod, $l;
 175     }
 176 }
 177
 178 say "Inserting entry for '$newpodpath' into $manifest; text will be '$abstract'" if $verbose;
 179 my $new_manifest_entry = "$newpodpath\t\t$abstract";
 180 my @new_pod = sort_manifest(@pod, $new_manifest_entry);
 181
 182 open(my $OUT, '>', $manifest)
 183     or croak "Can't open $manifest for writing";
 184 binmode($OUT);
 185 say $OUT join("\n", @before_pod, @new_pod, @after_pod);
 186 close($OUT) or croak "Can't close $manifest after writing";
 187
 188 my $perlpod = File::Spec->catfile(qw|pod perl.pod|);
 189
 190 say "Step 3: Add entry to $perlpod" if $verbose;
 191
 192 # Read the existing pod/perl.pod into memory.
 193 # Divide it into chunks before the selected section, the head2 of the selected
 194 # section, the selected section, and what comes after the selected section.
 195 # Add the stub and abstract for the new .pod file to the end of the selected
 196 # section.  (Manually reposition to taste.)
 197
 198 open(my $IN1, '<', $perlpod)
 199     or croak "Can't open $perlpod for reading";
 200 my $perlpod_str;
 201 {
 202     local $/;
 203     $perlpod_str = <$IN1>;
 204 }
 205 close($IN1) or croak "Can't close $perlpod after reading";
 206
 207 my $section_head = "=head2 $man_sections->{$section}";
 208 my @chunks = split $section_head, $perlpod_str;
 209 chomp $chunks[0]; # So we can use 'say' consistently later on
 210
 211 my @balance = split /\n/, $chunks[1];
 212 shift @balance; # $chunks[1] begins with a newline which we won't need to output
 213 my (@target_section, @after_section);
 214
 215 my $target = \@target_section;
 216 for my $l (@balance) {
 217     $target = \@after_section if $l =~ m/^=(head2|for)/;
 218     push @$target, $l;
 219 }
 220
 221 push @target_section, "    $stub\t\t$abstract";
 222
 223 open(my $OUT1, '>', $perlpod)
 224     or croak "Can't open $perlpod for writing";
 225 say $OUT1 $chunks[0];
 226 say $OUT1 $section_head;
 227 say $OUT1 join("\n" => @target_section), "\n";
 228 say $OUT1 join("\n" => @after_section), "\n";
 229 close $OUT1 or croak "Can't close $perlpod after writing";
 230
 231 my $podmak_command = './perl -Ilib Porting/pod_rules.pl --build-podmak --verbose';
 232 say "Step 4: Running '$podmak_command' to update win32/pod.mak."
 233     if $verbose;
 234
 235 system($podmak_command) and croak "'$podmak_command' failed";
 236
 237 system(qq|git add MANIFEST pod/perl.pod win32/pod.mak|)
 238     and croak "Unable to git-add three updated files";
 239
 240 if ($verbose) {
 241     say "Call 'git diff --staged' and inspect modified files; correct as needed.";
 242     say "Then run 'make test_porting'.";
 243     say "Then say 'git commit'.";
 244 }