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