This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor pod_rules.pl and buildtoc to use new functions in pod_lib.pl
[perl5.git] / pod / buildtoc
CommitLineData
41630250
JH
1#!/usr/bin/perl -w
2
3use strict;
b78c1104 4use vars qw(%Pragmata %Modules $Quiet);
41630250
JH
5use File::Spec;
6use File::Find;
7use FindBin;
41630250
JH
8use Text::Wrap;
9use Getopt::Long;
10
11no locale;
12
ccbc7283
NC
13# Assumption is that we're either already being run from the top level (*nix,
14# VMS), or have absolute paths in @INC (Win32, pod/Makefile)
d7816c47 15BEGIN {
d5e2eea9 16 my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
ccbc7283 17 chdir $Top or die "Can't chdir to $Top: $!";
d7816c47 18 require 'Porting/pod_lib.pl';
ad77fdb4 19}
41630250 20
b78c1104
NC
21die "$0: Usage: $0 [--quiet]\n"
22 unless GetOptions (quiet => \$Quiet) && !@ARGV;
41630250 23
c26a697b 24my $state = get_pod_metadata(0, 'pod/perltoc.pod');
57df8412 25
b78c1104 26warn @{$state->{inconsistent}} if @{$state->{inconsistent}};
41630250 27
0b01631d 28# Find all the modules
b78c1104
NC
29my @modpods;
30find(sub {
41630250
JH
31 if (/\.p(od|m)$/) {
32 my $file = $File::Find::name;
d5e2eea9 33 return if $file =~ qr!/lib/Pod/Functions.pm\z!; # Used only by pod itself
41630250
JH
34 return if $file =~ m!(?:^|/)t/!;
35 return if $file =~ m!lib/Attribute/Handlers/demo/!;
36 return if $file =~ m!lib/Net/FTP/.+\.pm!; # Hi, Graham! :-)
37 return if $file =~ m!lib/Math/BigInt/t/!;
38 return if $file =~ m!/Devel/PPPort/[Hh]arness|lib/Devel/Harness!i;
39 return if $file =~ m!XS/(?:APItest|Typemap)!;
be6d6286
HS
40 my $pod = $file;
41 return if $pod =~ s/pm$/pod/ && -e $pod;
bac61051 42 unless (open my $f, '<', $_) {
41630250
JH
43 warn "$0: bogus <$file>: $!";
44 system "ls", "-l", $file;
45 }
46 else {
47 my $line;
bac61051 48 while ($line = <$f>) {
41630250
JH
49 if ($line =~ /^=head1\s+NAME\b/) {
50 push @modpods, $file;
41630250
JH
51 return;
52 }
53 }
3533364a 54 warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
41630250
JH
55 }
56 }
b78c1104 57 }, 'lib');
41630250 58
b78c1104 59my_die "Can't find any pods!\n" unless @modpods;
41630250 60
b78c1104
NC
61my %done;
62for (@modpods) {
11eb54fe
NC
63 my $name = $_;
64 $name =~ s/\.p(m|od)$//;
65 $name =~ s-.*?/lib/--;
66 $name =~ s-/-::-g;
3eb77e4b
NC
67 next if $done{$name}++;
68
41630250 69 if ($name =~ /^[a-z]/) {
b78c1104 70 $Pragmata{$name} = $_;
41630250 71 } else {
b78c1104 72 $Modules{$name} = $_;
41630250 73 }
41630250
JH
74}
75
b78c1104
NC
76# Accumulating everything into a lexical before writing to disk dates from the
77# time when this script also provided the functionality of regen/pod_rules.pl
78# and this code was in a subroutine do_toc(). In turn, the use of a file scoped
79# lexical instead of a parameter or return value is because the code dates back
80# further still, and used *only* to create pod/perltoc.pod by printing direct
41630250 81
d871876a
NC
82my $OUT;
83
b78c1104 84($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250 85
97f32038
JH
86 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
87 # This file is autogenerated by buildtoc from all the other pods.
b78c1104 88 # Edit those files and run $0 to effect changes.
97f32038 89
41630250
JH
90 =head1 NAME
91
92 perltoc - perl documentation table of contents
93
94 =head1 DESCRIPTION
95
96 This page provides a brief table of contents for the rest of the Perl
97 documentation set. It is meant to be scanned quickly or grepped
98 through to locate the proper section you're looking for.
99
100 =head1 BASIC DOCUMENTATION
101
102EOPOD2B
41630250 103
b78c1104
NC
104# All the things in the master list that happen to be pod filenames
105foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @{$state->{master}}) {
f37610d8 106 podset(@$_);
b78c1104 107}
41630250
JH
108
109
b78c1104 110($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
111
112
113
114 =head1 PRAGMA DOCUMENTATION
115
116EOPOD2B
117
b78c1104 118foreach (sort keys %Pragmata) {
84f07fb2 119 podset($_, $Pragmata{$_});
b78c1104 120}
41630250 121
b78c1104 122($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
123
124
125
126 =head1 MODULE DOCUMENTATION
127
128EOPOD2B
129
b78c1104 130foreach (sort keys %Modules) {
84f07fb2 131 podset($_, $Modules{$_});
b78c1104 132}
41630250 133
b78c1104 134$_= <<"EOPOD2B";
41630250
JH
135
136
137 =head1 AUXILIARY DOCUMENTATION
138
139 Here should be listed all the extra programs' documentation, but they
140 don't all have manual pages yet:
141
142 =over 4
143
144EOPOD2B
145
b78c1104
NC
146$_ .= join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
147$_ .= <<"EOPOD2B" ;
41630250
JH
148
149 =back
150
151 =head1 AUTHOR
152
153 Larry Wall <F<larry\@wall.org>>, with the help of oodles
154 of other folks.
155
156
157EOPOD2B
158
b78c1104
NC
159s/^\t//gm;
160$OUT .= "$_\n";
d871876a 161
b78c1104
NC
162$OUT =~ s/\n\s+\n/\n\n/gs;
163$OUT =~ s/\n{3,}/\n\n/g;
b8ce93b8 164
b78c1104 165$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
b8ce93b8 166
3b0c5c72 167write_or_die('pod/perltoc.pod', $OUT);
b78c1104
NC
168
169exit(0);
41630250
JH
170
171# Below are all the auxiliary routines for generating perltoc.pod
172
173my ($inhead1, $inhead2, $initem);
174
175sub podset {
84f07fb2 176 my ($pod, $file) = @_;
41630250 177
536d7404
NC
178 local $/ = '';
179
ce9f0d31 180 open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
0b01631d 181
84f07fb2 182 while(<$fh>) {
16114dde 183 tr/\015//d;
41630250 184 if (s/^=head1 (NAME)\s*/=head2 /) {
41630250 185 unhead1();
c0f8aaaa 186 $OUT .= "\n\n=head2 ";
84f07fb2 187 $_ = <$fh>;
767650bc
NC
188 # Remove svn keyword expansions from the Perl FAQ
189 s/ \(\$Revision: \d+ \$\)//g;
32ebae07 190 if ( /^\s*\Q$pod\E\b/ ) {
41630250 191 s/$pod\.pm/$pod/; # '.pm' in NAME !?
41630250
JH
192 } else {
193 s/^/$pod, /;
41630250 194 }
41630250 195 }
1fa7865d 196 elsif (s/^=head1 (.*)/=item $1/) {
41630250 197 unhead2();
c0f8aaaa 198 $OUT .= "=over 4\n\n" unless $inhead1;
41630250 199 $inhead1 = 1;
1fa7865d 200 $_ .= "\n";
41630250 201 }
1fa7865d 202 elsif (s/^=head2 (.*)/=item $1/) {
41630250 203 unitem();
c0f8aaaa 204 $OUT .= "=over 4\n\n" unless $inhead2;
41630250 205 $inhead2 = 1;
1fa7865d 206 $_ .= "\n";
41630250 207 }
1fa7865d 208 elsif (s/^=item ([^=].*)/$1/) {
41630250
JH
209 next if $pod eq 'perldiag';
210 s/^\s*\*\s*$// && next;
211 s/^\s*\*\s*//;
212 s/\n/ /g;
213 s/\s+$//;
214 next if /^[\d.]+$/;
215 next if $pod eq 'perlmodlib' && /^ftp:/;
c0f8aaaa 216 $OUT .= ", " if $initem;
41630250
JH
217 $initem = 1;
218 s/\.$//;
219 s/^-X\b/-I<X>/;
41630250 220 }
1fa7865d
NC
221 else {
222 unhead1() if /^=cut\s*\n/;
41630250
JH
223 next;
224 }
1fa7865d 225 $OUT .= $_;
41630250
JH
226 }
227}
228
229sub unhead1 {
230 unhead2();
231 if ($inhead1) {
c0f8aaaa 232 $OUT .= "\n\n=back\n\n";
41630250
JH
233 }
234 $inhead1 = 0;
235}
236
237sub unhead2 {
238 unitem();
239 if ($inhead2) {
c0f8aaaa 240 $OUT .= "\n\n=back\n\n";
41630250
JH
241 }
242 $inhead2 = 0;
243}
244
245sub unitem {
246 if ($initem) {
c0f8aaaa 247 $OUT .= "\n\n";
41630250
JH
248 }
249 $initem = 0;
250}
251
b78c1104
NC
252# Code added in commit 416302502f485afa, but never used.
253# Probably roffitall should become something that buildtoc generates, instead
254# of something that we ship in the distribution.
41630250
JH
255
256sub generate_roffitall {
57df8412 257 (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
41630250 258 "\t\t\\",
57df8412 259 map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
41630250
JH
260 "\t\t\\",
261 map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
262 "\t\t\\",
263 map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
264 )
265}