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