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