This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7a9657ae2949a6420bf7c93d3aa9265fcfbd2a1c
[perl5.git] / pod / buildtoc
1 use File::Find;
2 use Cwd;
3
4 @pods = qw{
5             perl perldata perlsyn perlop perlre perlrun perlfunc perlvar
6             perlsub perlmod perlref perldsc perllol perlobj perltie
7             perlbot perldebug perldiag perlform perlipc perlsec perltrap
8             perlstyle perlxs perlxstut perlguts perlcall perlembed perlpod
9             perlbook 
10         };
11 for (@pods) { s/$/.pod/ } 
12
13 $/ = '';
14 @ARGV = @pods;
15
16 ($_= <<EOPOD2B) =~ s/^\t//gm && print;
17
18         =head1 NAME
19
20         perltoc - perl documentation table of contents
21
22         =head1 DESCRIPTION
23
24         This page provides a brief table of contents for the rest of the Perl 
25         documentation set.  It is meant to be be quickly scanned or grepped 
26         through to locate the proper section you're looking for.
27
28         =head1 BASIC DOCUMENTATION
29
30 EOPOD2B
31
32 podset(@pods);
33
34 find \&getpods => qw(../lib ../ext);
35 sub getpods {
36     if (/\.p(od|m)$/) { 
37         my $file = $File::Find::name;
38         die "tut $name" if $file =~ /TUT/;
39         unless (open (F, "< $_\0")) {
40             warn "bogus <$file>: $!";
41             system "ls", "-l", $file;
42         }  else { 
43             my $line;
44             while ($line = <F>) {
45                 if ($line =~ /^=head1\s+NAME\b/) {
46                     push @modpods, $file;
47                     #warn "GOOD $file\n";
48                     return;
49                 } 
50             } 
51             warn "EVIL $file\n";
52         }
53     }
54 }
55
56 die "no pods" unless @modpods;
57
58 for (@modpods) {
59     #($name) = /(\w+)\.p(m|od)$/;
60     $name = path2modname($_);
61     if ($name =~ /^[a-z]/) {
62         push @pragmata, $_;
63     } else {
64         if ($done{$name}++) {
65             # warn "already did $_\n";
66             next;
67         } 
68         push @modules, $_;
69         push @modname, $name;
70     } 
71
72
73 ($_= <<EOPOD2B) =~ s/^\t//gm && print;
74  
75
76
77         =head1 PRAGMA DOCUMENTATION
78
79 EOPOD2B
80
81 podset(sort @pragmata);
82
83 ($_= <<EOPOD2B) =~ s/^\t//gm && print;
84  
85
86
87         =head1 MODULE DOCUMENTATION
88
89 EOPOD2B
90
91 podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
92
93 ($_= <<EOPOD2B) =~ s/^\t//gm;
94  
95
96         =head1 AUXILIARY DOCUMENTATION
97
98         Here should be listed all the extra program's docs, but they
99         don't all have man pages yet:
100
101         =item a2p
102
103         =item s2p
104
105         =item find2perl
106         
107         =item h2ph
108         
109         =item c2ph
110
111         =item h2xs
112
113         =item xsubpp
114
115         =item pod2man 
116
117         =item wrapsuid
118
119
120         =head1 AUTHOR
121
122         Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles 
123         of other folks.
124
125
126 EOPOD2B
127 print;
128
129 exit;
130
131 sub podset {
132     local @ARGV = @_;
133
134     while(<>) {
135         if (s/^=head1 (NAME)\s*/=head2 /) {
136             $pod = path2modname($ARGV);
137             sub path2modname {
138                 local $_ = shift;
139                 s/\.p(m|od)$//;
140                 s-.*?/(lib|ext)/--;
141                 s-/-::-g;
142                 s/(\w+)::\1/$1/;
143                 return $_;
144             }
145             unitem(); unhead2();
146             print "\n \n\n=head2 ";
147             $_ = <>;
148             if ( /^\s*$pod\b/ ) {
149                 print;
150             } else {
151                 s/^/$pod, /;
152                 print;
153             } 
154             next;
155         }
156         if (s/^=head1 (.*)/=item $1/) {
157             unitem(); unhead2();
158             print; nl(); next;
159         } 
160         if (s/^=head2 (.*)/=item $1/) {
161             unitem();
162             print "=over\n\n" unless $inhead2;
163             $inhead2 = 1;
164             print; nl(); next;
165
166         } 
167         if (s/^=item (.*)\n/$1/) {
168             next if $pod eq 'perldiag';
169             s/^\s*\*\s*$// && next;
170             s/^\s*\*\s*//;
171             s/\s+$//;
172             next if /^[\d.]+$/;
173             next if $pod eq 'perlmod' && /^ftp:/;
174             ##print "=over\n\n" unless $initem;
175             print ", " if $initem;
176             $initem = 1;
177             s/\.$//;
178             print; next;
179         } 
180     } 
181
182
183
184 sub unhead2 {
185     if ($inhead2) {
186         print "\n\n=back\n\n";
187     } 
188     $inhead2 = 0; 
189     $initem = 0;
190
191
192 sub unitem {
193     if ($initem) {
194         print "\n\n";
195         ##print "\n\n=back\n\n";
196     } 
197     $initem = 0;
198
199
200 sub nl {
201     print "\n";
202