use File::Find;
use Cwd;
+use Text::Wrap;
-@pods = qw{
- perl perldata perlsyn perlop perlre perlrun perlfunc perlvar
- perlsub perlmod perlref perldsc perllol perlobj perltie
- perlbot perldebug perldiag perlform perlipc perlsec perltrap
- perlstyle perlxs perlxstut perlguts perlcall perlembed perlpod
- perlbook
- };
-for (@pods) { s/$/.pod/ }
+sub output ($);
+
+@pods = qw(
+ perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
+ perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
+ perlsyn perlop perlre perlrun perlfunc perlvar perlsub
+ perlmod perlmodlib perlmodinstall perlfork perlform perllocale
+ perlref perlreftut perldsc
+ perllol perlboot perltoot perltootc perlobj perltie perlbot perlipc
+ perldbmfilter perldebug perlnumber perldebguts
+ perldiag perlsec perltrap perlport perlstyle perlpod perlbook
+ perlembed perlapio perlxs perlxstut perlguts perlcall perlcompile
+ perlapi perlintern perlhist
+ );
+
+for (@pods) { s/$/.pod/ }
$/ = '';
@ARGV = @pods;
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
=head1 NAME
=head1 DESCRIPTION
- This page provides a brief table of contents for the rest of the Perl
- documentation set. It is meant to be be quickly scanned or grepped
+ This page provides a brief table of contents for the rest of the Perl
+ documentation set. It is meant to be scanned quickly or grepped
through to locate the proper section you're looking for.
=head1 BASIC DOCUMENTATION
EOPOD2B
+#' make emacs happy
podset(@pods);
find \&getpods => qw(../lib ../ext);
+
sub getpods {
- if (/\.p(od|m)$/) {
+ if (/\.p(od|m)$/) {
+ # Skip .pm files that have corresponding .pod files, and Functions.pm.
+ return if /(.*)\.pm$/ && -f "$1.pod";
my $file = $File::Find::name;
+ return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself
+
die "tut $name" if $file =~ /TUT/;
unless (open (F, "< $_\0")) {
warn "bogus <$file>: $!";
system "ls", "-l", $file;
- } else {
+ }
+ else {
my $line;
while ($line = <F>) {
if ($line =~ /^=head1\s+NAME\b/) {
push @modpods, $file;
#warn "GOOD $file\n";
return;
- }
- }
+ }
+ }
warn "EVIL $file\n";
}
}
if ($done{$name}++) {
# warn "already did $_\n";
next;
- }
+ }
push @modules, $_;
push @modname, $name;
- }
-}
+ }
+}
+
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
-
=head1 PRAGMA DOCUMENTATION
podset(sort @pragmata);
-($_= <<EOPOD2B) =~ s/^\t//gm && print;
-
+($_= <<EOPOD2B) =~ s/^\t//gm && output($_);
+
=head1 MODULE DOCUMENTATION
podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
($_= <<EOPOD2B) =~ s/^\t//gm;
-
+
=head1 AUXILIARY DOCUMENTATION
- Here should be listed all the extra program's docs, but they
- don't all have man pages yet:
+ Here should be listed all the extra programs' documentation, but they
+ don't all have manual pages yet:
+
+ =over
=item a2p
=item s2p
=item find2perl
-
+
=item h2ph
-
+
=item c2ph
=item h2xs
=item xsubpp
- =item pod2man
+ =item pod2man
=item wrapsuid
+ =back
=head1 AUTHOR
- Larry Wall E<lt><F<lwall\@sems.com>E<gt>, with the help of oodles
+ Larry Wall <F<larry\@wall.org>>, with the help of oodles
of other folks.
EOPOD2B
-print;
-
+output $_;
+output "\n"; # flush $LINE
exit;
sub podset {
while(<>) {
if (s/^=head1 (NAME)\s*/=head2 /) {
$pod = path2modname($ARGV);
- sub path2modname {
- local $_ = shift;
- s/\.p(m|od)$//;
- s-.*?/(lib|ext)/--;
- s-/-::-g;
- s/(\w+)::\1/$1/;
- return $_;
- }
- unitem(); unhead2();
- print "\n \n\n=head2 ";
+ unhead1();
+ output "\n \n\n=head2 ";
$_ = <>;
if ( /^\s*$pod\b/ ) {
- print;
+ s/$pod\.pm/$pod/; # '.pm' in NAME !?
+ output $_;
} else {
s/^/$pod, /;
- print;
- }
+ output $_;
+ }
next;
}
if (s/^=head1 (.*)/=item $1/) {
- unitem(); unhead2();
- print; nl(); next;
- }
+ unhead2();
+ output "=over\n\n" unless $inhead1;
+ $inhead1 = 1;
+ output $_; nl(); next;
+ }
if (s/^=head2 (.*)/=item $1/) {
unitem();
- print "=over\n\n" unless $inhead2;
+ output "=over\n\n" unless $inhead2;
$inhead2 = 1;
- print; nl(); next;
-
- }
- if (s/^=item (.*)\n/$1/) {
+ output $_; nl(); next;
+ }
+ if (s/^=item ([^=].*)\n/$1/) {
next if $pod eq 'perldiag';
s/^\s*\*\s*$// && next;
s/^\s*\*\s*//;
s/\s+$//;
next if /^[\d.]+$/;
- next if $pod eq 'perlmod' && /^ftp:/;
+ next if $pod eq 'perlmodlib' && /^ftp:/;
##print "=over\n\n" unless $initem;
- print ", " if $initem;
+ output ", " if $initem;
$initem = 1;
s/\.$//;
- print; next;
- }
- }
+ s/^-X\b/-I<X>/;
+ output $_; next;
+ }
+ if (s/^=cut\s*\n//) {
+ unhead1();
+ next;
+ }
+ }
+}
+
+sub path2modname {
+ local $_ = shift;
+ s/\.p(m|od)$//;
+ s-.*?/(lib|ext)/--;
+ s-/-::-g;
+ s/(\w+)::\1/$1/;
+ return $_;
+}
-}
+sub unhead1 {
+ unhead2();
+ if ($inhead1) {
+ output "\n\n=back\n\n";
+ }
+ $inhead1 = 0;
+}
sub unhead2 {
+ unitem();
if ($inhead2) {
- print "\n\n=back\n\n";
- }
- $inhead2 = 0;
- $initem = 0;
-}
+ output "\n\n=back\n\n";
+ }
+ $inhead2 = 0;
+}
sub unitem {
if ($initem) {
- print "\n\n";
+ output "\n\n";
##print "\n\n=back\n\n";
- }
+ }
$initem = 0;
-}
+}
sub nl {
- print "\n";
-}
+ output "\n";
+}
+
+my $NEWLINE; # how many newlines have we seen recently
+my $LINE; # what remains to be printed
+
+sub output ($) {
+ for (split /(\n)/, shift) {
+ if ($_ eq "\n") {
+ if ($LINE) {
+ print wrap('', '', $LINE);
+ $LINE = '';
+ }
+ if ($NEWLINE < 2) {
+ print;
+ $NEWLINE++;
+ }
+ }
+ elsif (/\S/ && length) {
+ $LINE .= $_;
+ $NEWLINE = 0;
+ }
+ }
+}