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