This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In buildtoc, refactor to de-duplicate code and variables.
[perl5.git] / pod / buildtoc
1 #!/usr/bin/perl -w
2
3 use strict;
4 use vars qw(%Found $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     $Found{$name =~ /^[a-z]/ ? 'PRAGMA' : 'MODULE'}{$name} = $_;
70 }
71
72 # Accumulating everything into a lexical before writing to disk dates from the
73 # time when this script also provided the functionality of regen/pod_rules.pl
74 # and this code was in a subroutine do_toc(). In turn, the use of a file scoped
75 # lexical instead of a parameter or return value is because the code dates back
76 # further still, and used *only* to create pod/perltoc.pod by printing direct
77
78 my $OUT;
79
80 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
81
82         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
83         # This file is autogenerated by buildtoc from all the other pods.
84         # Edit those files and run $0 to effect changes.
85
86         =head1 NAME
87
88         perltoc - perl documentation table of contents
89
90         =head1 DESCRIPTION
91
92         This page provides a brief table of contents for the rest of the Perl
93         documentation set.  It is meant to be scanned quickly or grepped
94         through to locate the proper section you're looking for.
95
96         =head1 BASIC DOCUMENTATION
97
98 EOPOD2B
99
100 # All the things in the master list that happen to be pod filenames
101 foreach (grep {defined $_ && @$_ == 3 && !$_->[0]{toc_omit}} @{$state->{master}}) {
102     podset(@$_);
103 }
104
105 foreach my $type (qw(PRAGMA MODULE)) {
106     ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
107
108
109
110         =head1 $type DOCUMENTATION
111
112 EOPOD2B
113
114     foreach my $name (sort keys %{$Found{$type}}) {
115         podset($name, $Found{$type}{$name});
116     }
117 }
118
119 $_= <<"EOPOD2B";
120
121
122         =head1 AUXILIARY DOCUMENTATION
123
124         Here should be listed all the extra programs' documentation, but they
125         don't all have manual pages yet:
126
127         =over 4
128
129 EOPOD2B
130
131 $_ .=  join "\n", map {"\t=item $_\n"} sort keys %{$state->{aux}};
132 $_ .= <<"EOPOD2B" ;
133
134         =back
135
136         =head1 AUTHOR
137
138         Larry Wall <F<larry\@wall.org>>, with the help of oodles
139         of other folks.
140
141
142 EOPOD2B
143
144 s/^\t//gm;
145 $OUT .= "$_\n";
146
147 $OUT =~ s/\n\s+\n/\n\n/gs;
148 $OUT =~ s/\n{3,}/\n\n/g;
149
150 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
151
152 write_or_die('pod/perltoc.pod', $OUT);
153
154 exit(0);
155
156 # Below are all the auxiliary routines for generating perltoc.pod
157
158 my ($inhead1, $inhead2, $initem);
159
160 sub podset {
161     my ($pod, $file) = @_;
162
163     local $/ = '';
164
165     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
166
167     while(<$fh>) {
168         tr/\015//d;
169         if (s/^=head1 (NAME)\s*/=head2 /) {
170             unhead1();
171             $OUT .= "\n\n=head2 ";
172             $_ = <$fh>;
173             # Remove svn keyword expansions from the Perl FAQ
174             s/ \(\$Revision: \d+ \$\)//g;
175             if ( /^\s*\Q$pod\E\b/ ) {
176                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
177             } else {
178                 s/^/$pod, /;
179             }
180         }
181         elsif (s/^=head1 (.*)/=item $1/) {
182             unhead2();
183             $OUT .= "=over 4\n\n" unless $inhead1;
184             $inhead1 = 1;
185             $_ .= "\n";
186         }
187         elsif (s/^=head2 (.*)/=item $1/) {
188             unitem();
189             $OUT .= "=over 4\n\n" unless $inhead2;
190             $inhead2 = 1;
191             $_ .= "\n";
192         }
193         elsif (s/^=item ([^=].*)/$1/) {
194             next if $pod eq 'perldiag';
195             s/^\s*\*\s*$// && next;
196             s/^\s*\*\s*//;
197             s/\n/ /g;
198             s/\s+$//;
199             next if /^[\d.]+$/;
200             next if $pod eq 'perlmodlib' && /^ftp:/;
201             $OUT .= ", " if $initem;
202             $initem = 1;
203             s/\.$//;
204             s/^-X\b/-I<X>/;
205         }
206         else {
207             unhead1() if /^=cut\s*\n/;
208             next;
209         }
210         $OUT .= $_;
211     }
212 }
213
214 sub unhead1 {
215     unhead2();
216     if ($inhead1) {
217         $OUT .= "\n\n=back\n\n";
218     }
219     $inhead1 = 0;
220 }
221
222 sub unhead2 {
223     unitem();
224     if ($inhead2) {
225         $OUT .= "\n\n=back\n\n";
226     }
227     $inhead2 = 0;
228 }
229
230 sub unitem {
231     if ($initem) {
232         $OUT .= "\n\n";
233     }
234     $initem = 0;
235 }
236
237 # Code added in commit 416302502f485afa, but never used.
238 # Probably roffitall should become something that buildtoc generates, instead
239 # of something that we ship in the distribution.
240
241 sub generate_roffitall {
242   (map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{pods}}),
243    "\t\t\\",
244    map ({"\t\$maindir/$_.1\t\\"}sort keys %{$state->{aux}}),
245    "\t\t\\",
246    map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{PRAGMA}}),
247    "\t\t\\",
248    map ({"\t\$libdir/$_.3\t\\"}sort keys %{$Found{MODULE}}),
249   )
250 }