[inseparable changes from patch from perl5.003_18 to perl5.003_19]
[perl.git] / pod / buildtoc
1 use File::Find;
2 use Cwd;
3 use Text::Wrap;
4
5 sub output ($);
6
7 @pods = qw(
8             perl perlnews perldata perlsyn perlop perlre perlrun perlfunc
9             perlvar perlsub perlmod perlform perllocale perlref perldsc
10             perllol perltoot perlobj perltie perlbot perlipc perldebug
11             perldiag perlsec perltrap perlstyle perlpod perlbook
12             perlembed perlapio perlxs perlxstut perlguts perlcall
13           );
14
15 for (@pods) { s/$/.pod/ }
16
17 $/ = '';
18 @ARGV = @pods;
19
20 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
21
22         =head1 NAME
23
24         perltoc - perl documentation table of contents
25
26         =head1 DESCRIPTION
27
28         This page provides a brief table of contents for the rest of the Perl
29         documentation set.  It is meant to be bescanned quickly or grepped
30         through to locate the proper section you're looking for.
31
32         =head1 BASIC DOCUMENTATION
33
34 EOPOD2B
35 #' make emacs happy
36
37 podset(@pods);
38
39 find \&getpods => qw(../lib ../ext);
40
41 sub getpods {
42     if (/\.p(od|m)$/) {
43         # Skip .pm files that have corresponding .pod files, and Functions.pm.
44         return if /(.*)\.pm$/ && -f "$1.pod";
45         my $file = $File::Find::name;
46         return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
47
48         die "tut $name" if $file =~ /TUT/;
49         unless (open (F, "< $_\0")) {
50             warn "bogus <$file>: $!";
51             system "ls", "-l", $file;
52         }
53         else {
54             my $line;
55             while ($line = <F>) {
56                 if ($line =~ /^=head1\s+NAME\b/) {
57                     push @modpods, $file;
58                     #warn "GOOD $file\n";
59                     return;
60                 }
61             }
62             warn "EVIL $file\n";
63         }
64     }
65 }
66
67 die "no pods" unless @modpods;
68
69 for (@modpods) {
70     #($name) = /(\w+)\.p(m|od)$/;
71     $name = path2modname($_);
72     if ($name =~ /^[a-z]/) {
73         push @pragmata, $_;
74     } else {
75         if ($done{$name}++) {
76             # warn "already did $_\n";
77             next;
78         }
79         push @modules, $_;
80         push @modname, $name;
81     }
82 }
83
84 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
85
86
87
88         =head1 PRAGMA DOCUMENTATION
89
90 EOPOD2B
91
92 podset(sort @pragmata);
93
94 ($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
95
96
97
98         =head1 MODULE DOCUMENTATION
99
100 EOPOD2B
101
102 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
103
104 ($_= <<EOPOD2B) =~ s/^\t//gm;
105
106
107         =head1 AUXILIARY DOCUMENTATION
108
109         Here should be listed all the extra programs' documentation, but they
110         don't all have manual pages yet:
111
112         =item a2p
113
114         =item s2p
115
116         =item find2perl
117
118         =item h2ph
119
120         =item c2ph
121
122         =item h2xs
123
124         =item xsubpp
125
126         =item pod2man
127
128         =item wrapsuid
129
130
131         =head1 AUTHOR
132
133         Larry Wall E<lt>F<larry\@wall.org>E<gt>, with the help of oodles
134         of other folks.
135
136
137 EOPOD2B
138 output $_;
139 output "\n";                    # flush $LINE
140 exit;
141
142 sub podset {
143     local @ARGV = @_;
144
145     while(<>) {
146         if (s/^=head1 (NAME)\s*/=head2 /) {
147             $pod = path2modname($ARGV);
148             unitem();
149             unhead2();
150             output "\n \n\n=head2 ";
151             $_ = <>;
152             if ( /^\s*$pod\b/ ) {
153                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
154                 output $_;
155             } else {
156                 s/^/$pod, /;
157                 output $_;
158             }
159             next;
160         }
161         if (s/^=head1 (.*)/=item $1/) {
162             unitem(); unhead2();
163             output $_; nl(); next;
164         }
165         if (s/^=head2 (.*)/=item $1/) {
166             unitem();
167             output "=over\n\n" unless $inhead2;
168             $inhead2 = 1;
169             output $_; nl(); next;
170
171         }
172         if (s/^=item (.*)\n/$1/) {
173             next if $pod eq 'perldiag';
174             s/^\s*\*\s*$// && next;
175             s/^\s*\*\s*//;
176             s/\s+$//;
177             next if /^[\d.]+$/;
178             next if $pod eq 'perlmod' && /^ftp:/;
179             ##print "=over\n\n" unless $initem;
180             output ", " if $initem;
181             $initem = 1;
182             s/\.$//;
183             s/^-X\b/-I<X>/;
184             output $_; next;
185         }
186     }
187 }
188
189 sub path2modname {
190     local $_ = shift;
191     s/\.p(m|od)$//;
192     s-.*?/(lib|ext)/--;
193     s-/-::-g;
194     s/(\w+)::\1/$1/;
195     return $_;
196 }
197
198 sub unhead2 {
199     if ($inhead2) {
200         output "\n\n=back\n\n";
201     }
202     $inhead2 = 0;
203     $initem  = 0;
204 }
205
206 sub unitem {
207     if ($initem) {
208         output "\n\n";
209         ##print "\n\n=back\n\n";
210     }
211     $initem = 0;
212 }
213
214 sub nl {
215     output "\n";
216 }
217
218 my $NEWLINE;    # how many newlines have we seen recently
219 my $LINE;       # what remains to be printed
220
221 sub output ($) {
222     for (split /(\n)/, shift) {
223         if ($_ eq "\n") {
224             if ($LINE) {
225                 print wrap('', '', $LINE);
226                 $LINE = '';
227             }
228             if ($NEWLINE < 2) {
229                 print;
230                 $NEWLINE++;
231             }
232         }
233         elsif (/\S/ && length) {
234             $LINE .= $_;
235             $NEWLINE = 0;
236         }
237     }
238 }