This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
530dd2d71bae743940cad762be177feed24e2bc3
[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 write_or_die('pod/perltoc.pod', $OUT);
168
169 exit(0);
170
171 # Below are all the auxiliary routines for generating perltoc.pod
172
173 my ($inhead1, $inhead2, $initem);
174
175 sub podset {
176     my ($pod, $file) = @_;
177
178     local $/ = '';
179
180     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
181
182     while(<$fh>) {
183         tr/\015//d;
184         if (s/^=head1 (NAME)\s*/=head2 /) {
185             unhead1();
186             $OUT .= "\n\n=head2 ";
187             $_ = <$fh>;
188             # Remove svn keyword expansions from the Perl FAQ
189             s/ \(\$Revision: \d+ \$\)//g;
190             if ( /^\s*\Q$pod\E\b/ ) {
191                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
192             } else {
193                 s/^/$pod, /;
194             }
195         }
196         elsif (s/^=head1 (.*)/=item $1/) {
197             unhead2();
198             $OUT .= "=over 4\n\n" unless $inhead1;
199             $inhead1 = 1;
200             $_ .= "\n";
201         }
202         elsif (s/^=head2 (.*)/=item $1/) {
203             unitem();
204             $OUT .= "=over 4\n\n" unless $inhead2;
205             $inhead2 = 1;
206             $_ .= "\n";
207         }
208         elsif (s/^=item ([^=].*)/$1/) {
209             next if $pod eq 'perldiag';
210             s/^\s*\*\s*$// && next;
211             s/^\s*\*\s*//;
212             s/\n/ /g;
213             s/\s+$//;
214             next if /^[\d.]+$/;
215             next if $pod eq 'perlmodlib' && /^ftp:/;
216             $OUT .= ", " if $initem;
217             $initem = 1;
218             s/\.$//;
219             s/^-X\b/-I<X>/;
220         }
221         else {
222             unhead1() if /^=cut\s*\n/;
223             next;
224         }
225         $OUT .= $_;
226     }
227 }
228
229 sub unhead1 {
230     unhead2();
231     if ($inhead1) {
232         $OUT .= "\n\n=back\n\n";
233     }
234     $inhead1 = 0;
235 }
236
237 sub unhead2 {
238     unitem();
239     if ($inhead2) {
240         $OUT .= "\n\n=back\n\n";
241     }
242     $inhead2 = 0;
243 }
244
245 sub unitem {
246     if ($initem) {
247         $OUT .= "\n\n";
248     }
249     $initem = 0;
250 }
251
252 # Code added in commit 416302502f485afa, but never used.
253 # Probably roffitall should become something that buildtoc generates, instead
254 # of something that we ship in the distribution.
255
256 sub generate_roffitall {
257   (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
258    "\t\t\\",
259    map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
260    "\t\t\\",
261    map ({"\t\$libdir/$_.3\t\\"}sort keys %Pragmata),
262    "\t\t\\",
263    map ({"\t\$libdir/$_.3\t\\"}sort keys %Modules),
264   )
265 }