Commit | Line | Data |
cb1a09d0 |
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 | |
c07a80fd |
122 | Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles |
cb1a09d0 |
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 | } |