This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, refactor to de-duplicate code and variables.
[perl5.git] / pod / buildtoc
CommitLineData
41630250
JH
1#!/usr/bin/perl -w
2
3use strict;
8c9aa8a0 4use vars qw(%Found $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
8c9aa8a0 69 $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
41630250
JH
70}
71
b78c1104
NC
72# Accumulating everything into a lexical before writing to disk dates from the
73# time when this script also provided the functionality of regen/pod_rules.pl
74# and this code was in a subroutine do_toc(). In turn, the use of a file scoped
75# lexical instead of a parameter or return value is because the code dates back
76# further still, and used *only* to create pod/perltoc.pod by printing direct
41630250 77
d871876a
NC
78my $OUT;
79
b78c1104 80($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250 81
97f32038
JH
82 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
83 # This file is autogenerated by buildtoc from all the other pods.
b78c1104 84 # Edit those files and run $0 to effect changes.
97f32038 85
41630250
JH
86 =head1 NAME
87
88 perltoc - perl documentation table of contents
89
90 =head1 DESCRIPTION
91
92 This page provides a brief table of contents for the rest of the Perl
93 documentation set. It is meant to be scanned quickly or grepped
94 through to locate the proper section you're looking for.
95
96 =head1 BASIC DOCUMENTATION
97
98EOPOD2B
41630250 99
b78c1104
NC
100# All the things in the master list that happen to be pod filenames
101foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @{$state->{master}}) {
f37610d8 102 podset(@$_);
b78c1104 103}
41630250 104
8c9aa8a0
NC
105foreach my $type (qw(PRAGMA MODULE)) {
106 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
107
108
109
8c9aa8a0 110 =head1 $type DOCUMENTATION
41630250
JH
111
112EOPOD2B
113
8c9aa8a0
NC
114 foreach my $name (sort keys %{$Found{$type}}) {
115 podset($name, $Found{$type}{$name});
116 }
b78c1104 117}
41630250 118
b78c1104 119$_= <<"EOPOD2B";
41630250
JH
120
121
122 =head1 AUXILIARY DOCUMENTATION
123
124 Here should be listed all the extra programs' documentation, but they
125 don't all have manual pages yet:
126
127 =over 4
128
129EOPOD2B
130
b78c1104
NC
131$_ .= join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
132$_ .= <<"EOPOD2B" ;
41630250
JH
133
134 =back
135
136 =head1 AUTHOR
137
138 Larry Wall <F<larry\@wall.org>>, with the help of oodles
139 of other folks.
140
141
142EOPOD2B
143
b78c1104
NC
144s/^\t//gm;
145$OUT .= "$_\n";
d871876a 146
b78c1104
NC
147$OUT =~ s/\n\s+\n/\n\n/gs;
148$OUT =~ s/\n{3,}/\n\n/g;
b8ce93b8 149
b78c1104 150$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
b8ce93b8 151
3b0c5c72 152write_or_die('pod/perltoc.pod', $OUT);
b78c1104
NC
153
154exit(0);
41630250
JH
155
156# Below are all the auxiliary routines for generating perltoc.pod
157
158my ($inhead1, $inhead2, $initem);
159
160sub podset {
84f07fb2 161 my ($pod, $file) = @_;
41630250 162
536d7404
NC
163 local $/ = '';
164
ce9f0d31 165 open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
0b01631d 166
84f07fb2 167 while(<$fh>) {
16114dde 168 tr/\015//d;
41630250 169 if (s/^=head1 (NAME)\s*/=head2 /) {
41630250 170 unhead1();
c0f8aaaa 171 $OUT .= "\n\n=head2 ";
84f07fb2 172 $_ = <$fh>;
767650bc
NC
173 # Remove svn keyword expansions from the Perl FAQ
174 s/ \(\$Revision: \d+ \$\)//g;
32ebae07 175 if ( /^\s*\Q$pod\E\b/ ) {
41630250 176 s/$pod\.pm/$pod/; # '.pm' in NAME !?
41630250
JH
177 } else {
178 s/^/$pod, /;
41630250 179 }
41630250 180 }
1fa7865d 181 elsif (s/^=head1 (.*)/=item $1/) {
41630250 182 unhead2();
c0f8aaaa 183 $OUT .= "=over 4\n\n" unless $inhead1;
41630250 184 $inhead1 = 1;
1fa7865d 185 $_ .= "\n";
41630250 186 }
1fa7865d 187 elsif (s/^=head2 (.*)/=item $1/) {
41630250 188 unitem();
c0f8aaaa 189 $OUT .= "=over 4\n\n" unless $inhead2;
41630250 190 $inhead2 = 1;
1fa7865d 191 $_ .= "\n";
41630250 192 }
1fa7865d 193 elsif (s/^=item ([^=].*)/$1/) {
41630250
JH
194 next if $pod eq 'perldiag';
195 s/^\s*\*\s*$// && next;
196 s/^\s*\*\s*//;
197 s/\n/ /g;
198 s/\s+$//;
199 next if /^[\d.]+$/;
200 next if $pod eq 'perlmodlib' && /^ftp:/;
c0f8aaaa 201 $OUT .= ", " if $initem;
41630250
JH
202 $initem = 1;
203 s/\.$//;
204 s/^-X\b/-I<X>/;
41630250 205 }
1fa7865d
NC
206 else {
207 unhead1() if /^=cut\s*\n/;
41630250
JH
208 next;
209 }
1fa7865d 210 $OUT .= $_;
41630250
JH
211 }
212}
213
214sub unhead1 {
215 unhead2();
216 if ($inhead1) {
c0f8aaaa 217 $OUT .= "\n\n=back\n\n";
41630250
JH
218 }
219 $inhead1 = 0;
220}
221
222sub unhead2 {
223 unitem();
224 if ($inhead2) {
c0f8aaaa 225 $OUT .= "\n\n=back\n\n";
41630250
JH
226 }
227 $inhead2 = 0;
228}
229
230sub unitem {
231 if ($initem) {
c0f8aaaa 232 $OUT .= "\n\n";
41630250
JH
233 }
234 $initem = 0;
235}
236
b78c1104
NC
237# Code added in commit 416302502f485afa, but never used.
238# Probably roffitall should become something that buildtoc generates, instead
239# of something that we ship in the distribution.
41630250
JH
240
241sub generate_roffitall {
57df8412 242 (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
41630250 243 "\t\t\\",
57df8412 244 map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
41630250 245 "\t\t\\",
8c9aa8a0 246 map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{PRAGMA}}),
41630250 247 "\t\t\\",
8c9aa8a0 248 map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{MODULE}}),
41630250
JH
249 )
250}