This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the common Pod scanning code from installman and buildtoc to pod_lib.pl
[perl5.git] / pod / buildtoc
CommitLineData
41630250
JH
1#!/usr/bin/perl -w
2
3use strict;
9bbb230a 4use vars qw($Quiet);
41630250 5use File::Spec;
41630250 6use FindBin;
41630250
JH
7use Text::Wrap;
8use Getopt::Long;
9
10no locale;
11
ccbc7283
NC
12# Assumption is that we're either already being run from the top level (*nix,
13# VMS), or have absolute paths in @INC (Win32, pod/Makefile)
d7816c47 14BEGIN {
d5e2eea9 15 my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
ccbc7283 16 chdir $Top or die "Can't chdir to $Top: $!";
d7816c47 17 require 'Porting/pod_lib.pl';
ad77fdb4 18}
41630250 19
b78c1104
NC
20die "$0: Usage: $0 [--quiet]\n"
21 unless GetOptions (quiet => \$Quiet) && !@ARGV;
41630250 22
d4c6b7ae 23my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
41630250 24
9bbb230a
NC
25my $found = pods_to_install();
26
27my_die "Can't find any pods!\n" unless %$found;
41630250 28
b78c1104
NC
29# Accumulating everything into a lexical before writing to disk dates from the
30# time when this script also provided the functionality of regen/pod_rules.pl
31# and this code was in a subroutine do_toc(). In turn, the use of a file scoped
32# lexical instead of a parameter or return value is because the code dates back
33# further still, and used *only* to create pod/perltoc.pod by printing direct
41630250 34
d871876a 35my $OUT;
60f0ee9d 36my $roffitall;
d871876a 37
b78c1104 38($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250 39
97f32038
JH
40 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
41 # This file is autogenerated by buildtoc from all the other pods.
b78c1104 42 # Edit those files and run $0 to effect changes.
97f32038 43
41630250
JH
44 =head1 NAME
45
46 perltoc - perl documentation table of contents
47
48 =head1 DESCRIPTION
49
50 This page provides a brief table of contents for the rest of the Perl
51 documentation set. It is meant to be scanned quickly or grepped
52 through to locate the proper section you're looking for.
53
54 =head1 BASIC DOCUMENTATION
55
56EOPOD2B
41630250 57
b78c1104 58# All the things in the master list that happen to be pod filenames
2ce3647c
NC
59foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
60 $roffitall .= " \$mandir/$_->[0].1 \\\n";
61 podset($_->[0], $_->[1]);
b78c1104 62}
41630250 63
8c9aa8a0
NC
64foreach my $type (qw(PRAGMA MODULE)) {
65 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
41630250
JH
66
67
68
8c9aa8a0 69 =head1 $type DOCUMENTATION
41630250
JH
70
71EOPOD2B
72
9bbb230a 73 foreach my $name (sort keys %{$found->{$type}}) {
524b4932 74 $roffitall .= " \$libdir/$name.3 \\\n";
9bbb230a 75 podset($name, $found->{$type}{$name});
8c9aa8a0 76 }
b78c1104 77}
41630250 78
b78c1104 79$_= <<"EOPOD2B";
41630250
JH
80
81
82 =head1 AUXILIARY DOCUMENTATION
83
84 Here should be listed all the extra programs' documentation, but they
85 don't all have manual pages yet:
86
87 =over 4
88
89EOPOD2B
90
4e604983 91$_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}};
b78c1104 92$_ .= <<"EOPOD2B" ;
41630250
JH
93
94 =back
95
96 =head1 AUTHOR
97
98 Larry Wall <F<larry\@wall.org>>, with the help of oodles
99 of other folks.
100
101
102EOPOD2B
103
b78c1104
NC
104s/^\t//gm;
105$OUT .= "$_\n";
d871876a 106
b78c1104
NC
107$OUT =~ s/\n\s+\n/\n\n/gs;
108$OUT =~ s/\n{3,}/\n\n/g;
b8ce93b8 109
b78c1104 110$OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
b8ce93b8 111
3b0c5c72 112write_or_die('pod/perltoc.pod', $OUT);
b78c1104 113
60f0ee9d
NC
114write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT');
115#!/bin/sh
116#
117# Usage: roffitall [-nroff|-psroff|-groff]
118#
119# Authors: Tom Christiansen, Raphael Manfredi
120
121me=roffitall
122tmp=.
123
124if test -f ../config.sh; then
125 . ../config.sh
126fi
127
128mandir=$installman1dir
129libdir=$installman3dir
130
131test -d $mandir || mandir=/usr/new/man/man1
132test -d $libdir || libdir=/usr/new/man/man3
133
134case "$1" in
135-nroff) cmd="nroff -man"; ext='txt';;
136-psroff) cmd="psroff -t"; ext='ps';;
137-groff) cmd="groff -man"; ext='ps';;
138*)
139 echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2
140 exit 1
141 ;;
142esac
143
144toroff=`
145 echo \
146EOH
147 | perl -ne 'map { -r && print "$_ " } split'`
148
149 # Bypass internal shell buffer limit -- can't use case
150 if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
151 echo "$me: empty file list -- did you run install?" >&2
152 exit 1
153 fi
154
155 #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
156 #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
157
158 # First, create the raw data
159 run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
160 echo "$me: running $run"
161 eval $run $toroff
162
163 #Now create the TOC
164 echo "$me: parsing TOC"
165 perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
166 run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
167 echo "$me: running $run"
168 eval $run
169
170 # Finally, recreate the Doc, without the blank page 0
171 run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
172 echo "$me: running $run"
173 eval $run $toroff
174 rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
175 echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
176EOT
177
b78c1104 178exit(0);
41630250
JH
179
180# Below are all the auxiliary routines for generating perltoc.pod
181
182my ($inhead1, $inhead2, $initem);
183
184sub podset {
524b4932 185 my ($pod, $file) = @_;
41630250 186
3a527656
NC
187 open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
188
4027e27b 189 local *_;
3a527656
NC
190 my $found_pod;
191 while (<$fh>) {
192 if (/^=head1\s+NAME\b/) {
193 ++$found_pod;
194 last;
195 }
196 }
536d7404 197
3a527656
NC
198 unless ($found_pod) {
199 warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
200 return;
201 }
202
203 seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
204 local $/ = '';
0b01631d 205
84f07fb2 206 while(<$fh>) {
16114dde 207 tr/\015//d;
41630250 208 if (s/^=head1 (NAME)\s*/=head2 /) {
41630250 209 unhead1();
c0f8aaaa 210 $OUT .= "\n\n=head2 ";
84f07fb2 211 $_ = <$fh>;
767650bc
NC
212 # Remove svn keyword expansions from the Perl FAQ
213 s/ \(\$Revision: \d+ \$\)//g;
32ebae07 214 if ( /^\s*\Q$pod\E\b/ ) {
41630250 215 s/$pod\.pm/$pod/; # '.pm' in NAME !?
41630250
JH
216 } else {
217 s/^/$pod, /;
41630250 218 }
41630250 219 }
1fa7865d 220 elsif (s/^=head1 (.*)/=item $1/) {
41630250 221 unhead2();
c0f8aaaa 222 $OUT .= "=over 4\n\n" unless $inhead1;
41630250 223 $inhead1 = 1;
1fa7865d 224 $_ .= "\n";
41630250 225 }
1fa7865d 226 elsif (s/^=head2 (.*)/=item $1/) {
41630250 227 unitem();
c0f8aaaa 228 $OUT .= "=over 4\n\n" unless $inhead2;
41630250 229 $inhead2 = 1;
1fa7865d 230 $_ .= "\n";
41630250 231 }
1fa7865d 232 elsif (s/^=item ([^=].*)/$1/) {
41630250
JH
233 next if $pod eq 'perldiag';
234 s/^\s*\*\s*$// && next;
235 s/^\s*\*\s*//;
236 s/\n/ /g;
237 s/\s+$//;
238 next if /^[\d.]+$/;
239 next if $pod eq 'perlmodlib' && /^ftp:/;
c0f8aaaa 240 $OUT .= ", " if $initem;
41630250
JH
241 $initem = 1;
242 s/\.$//;
243 s/^-X\b/-I<X>/;
41630250 244 }
1fa7865d
NC
245 else {
246 unhead1() if /^=cut\s*\n/;
41630250
JH
247 next;
248 }
1fa7865d 249 $OUT .= $_;
41630250
JH
250 }
251}
252
253sub unhead1 {
254 unhead2();
255 if ($inhead1) {
c0f8aaaa 256 $OUT .= "\n\n=back\n\n";
41630250
JH
257 }
258 $inhead1 = 0;
259}
260
261sub unhead2 {
262 unitem();
263 if ($inhead2) {
c0f8aaaa 264 $OUT .= "\n\n=back\n\n";
41630250
JH
265 }
266 $inhead2 = 0;
267}
268
269sub unitem {
270 if ($initem) {
c0f8aaaa 271 $OUT .= "\n\n";
41630250
JH
272 }
273 $initem = 0;
274}
b1a2f073
NC
275
276# Local variables:
277# cperl-indent-level: 4
278# indent-tabs-mode: nil
279# End:
280#
281# ex: set ts=8 sts=4 sw=4 et: