Convert some SvREFCNT_dec's to SvREFCNT_dec_NN's for efficiency
[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         =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
56 EOPOD2B
57
58 # All the things in the master list that happen to be pod filenames
59 foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
60     $roffitall .= "    \$mandir/$_->[0].1 \\\n";
61     podset($_->[0], $_->[1]);
62 }
63
64 foreach my $type (qw(PRAGMA MODULE)) {
65     ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
66
67
68
69         =head1 $type DOCUMENTATION
70
71 EOPOD2B
72
73     foreach my $name (sort keys %{$found->{$type}}) {
74         $roffitall .= "    \$libdir/$name.3 \\\n";
75         podset($name, $found->{$type}{$name});
76     }
77 }
78
79 $_= <<"EOPOD2B";
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
89 EOPOD2B
90
91 $_ .=  join "\n", map {"\t=item $_\n"} @{$state->{aux}};
92 $_ .= <<"EOPOD2B" ;
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
102 EOPOD2B
103
104 s/^\t//gm;
105 $OUT .= "$_\n";
106
107 $OUT =~ s/\n\s+\n/\n\n/gs;
108 $OUT =~ s/\n{3,}/\n\n/g;
109
110 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
111
112 write_or_die('pod/perltoc.pod', $OUT);
113
114 write_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
121 me=roffitall
122 tmp=.
123
124 if test -f ../config.sh; then
125         . ../config.sh
126 fi
127
128 mandir=$installman1dir
129 libdir=$installman3dir
130
131 test -d $mandir || mandir=/usr/new/man/man1
132 test -d $libdir || libdir=/usr/new/man/man3
133
134 case "$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         ;;
142 esac
143
144 toroff=`
145         echo            \
146 EOH
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"
176 EOT
177
178 exit(0);
179
180 # Below are all the auxiliary routines for generating perltoc.pod
181
182 my ($inhead1, $inhead2, $initem);
183
184 sub podset {
185     my ($pod, $file) = @_;
186
187     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
188
189     local *_;
190     my $found_pod;
191     while (<$fh>) {
192         if (/^=head1\s+NAME\b/) {
193             ++$found_pod;
194             last;
195         }
196     }
197
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 $/ = '';
205
206     while(<$fh>) {
207         tr/\015//d;
208         if (s/^=head1 (NAME)\s*/=head2 /) {
209             unhead1();
210             $OUT .= "\n\n=head2 ";
211             $_ = <$fh>;
212             # Remove svn keyword expansions from the Perl FAQ
213             s/ \(\$Revision: \d+ \$\)//g;
214             if ( /^\s*\Q$pod\E\b/ ) {
215                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
216             } else {
217                 s/^/$pod, /;
218             }
219         }
220         elsif (s/^=head1 (.*)/=item $1/) {
221             unhead2();
222             $OUT .= "=over 4\n\n" unless $inhead1;
223             $inhead1 = 1;
224             $_ .= "\n";
225         }
226         elsif (s/^=head2 (.*)/=item $1/) {
227             unitem();
228             $OUT .= "=over 4\n\n" unless $inhead2;
229             $inhead2 = 1;
230             $_ .= "\n";
231         }
232         elsif (s/^=item ([^=].*)/$1/) {
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:/;
240             $OUT .= ", " if $initem;
241             $initem = 1;
242             s/\.$//;
243             s/^-X\b/-I<X>/;
244         }
245         else {
246             unhead1() if /^=cut\s*\n/;
247             next;
248         }
249         $OUT .= $_;
250     }
251 }
252
253 sub unhead1 {
254     unhead2();
255     if ($inhead1) {
256         $OUT .= "\n\n=back\n\n";
257     }
258     $inhead1 = 0;
259 }
260
261 sub unhead2 {
262     unitem();
263     if ($inhead2) {
264         $OUT .= "\n\n=back\n\n";
265     }
266     $inhead2 = 0;
267 }
268
269 sub unitem {
270     if ($initem) {
271         $OUT .= "\n\n";
272     }
273     $initem = 0;
274 }
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: