diff options
Diffstat (limited to 'contrib/perl5/pod/buildtoc')
| -rw-r--r-- | contrib/perl5/pod/buildtoc | 241 |
1 files changed, 241 insertions, 0 deletions
diff --git a/contrib/perl5/pod/buildtoc b/contrib/perl5/pod/buildtoc new file mode 100644 index 0000000..80ca2ec --- /dev/null +++ b/contrib/perl5/pod/buildtoc @@ -0,0 +1,241 @@ +use File::Find; +use Cwd; +use Text::Wrap; + +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 perlform perllocale perlref perldsc + perllol perltoot perlobj perltie perlbot perlipc perldebug + perldiag perlsec perltrap perlport perlstyle perlpod perlbook + perlembed perlapio perlxs perlxstut perlguts perlcall + perlhist + ); + +for (@pods) { s/$/.pod/ } + +$/ = ''; +@ARGV = @pods; + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + =head1 NAME + + perltoc - perl documentation table of contents + + =head1 DESCRIPTION + + 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)$/) { + # 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 { + my $line; + while ($line = <F>) { + if ($line =~ /^=head1\s+NAME\b/) { + push @modpods, $file; + #warn "GOOD $file\n"; + return; + } + } + warn "EVIL $file\n"; + } + } +} + +die "no pods" unless @modpods; + +for (@modpods) { + #($name) = /(\w+)\.p(m|od)$/; + $name = path2modname($_); + if ($name =~ /^[a-z]/) { + push @pragmata, $_; + } else { + if ($done{$name}++) { + # warn "already did $_\n"; + next; + } + push @modules, $_; + push @modname, $name; + } +} + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + + + =head1 PRAGMA DOCUMENTATION + +EOPOD2B + +podset(sort @pragmata); + +($_= <<EOPOD2B) =~ s/^\t//gm && output($_); + + + + =head1 MODULE DOCUMENTATION + +EOPOD2B + +podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] ); + +($_= <<EOPOD2B) =~ s/^\t//gm; + + + =head1 AUXILIARY DOCUMENTATION + + Here should be listed all the extra programs' documentation, but they + don't all have manual pages yet: + + =item a2p + + =item s2p + + =item find2perl + + =item h2ph + + =item c2ph + + =item h2xs + + =item xsubpp + + =item pod2man + + =item wrapsuid + + + =head1 AUTHOR + + Larry Wall <F<larry\@wall.org>>, with the help of oodles + of other folks. + + +EOPOD2B +output $_; +output "\n"; # flush $LINE +exit; + +sub podset { + local @ARGV = @_; + + while(<>) { + if (s/^=head1 (NAME)\s*/=head2 /) { + $pod = path2modname($ARGV); + unitem(); + unhead2(); + output "\n \n\n=head2 "; + $_ = <>; + if ( /^\s*$pod\b/ ) { + s/$pod\.pm/$pod/; # '.pm' in NAME !? + output $_; + } else { + s/^/$pod, /; + output $_; + } + next; + } + if (s/^=head1 (.*)/=item $1/) { + unitem(); unhead2(); + output $_; nl(); next; + } + if (s/^=head2 (.*)/=item $1/) { + unitem(); + output "=over\n\n" unless $inhead2; + $inhead2 = 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 'perlmodlib' && /^ftp:/; + ##print "=over\n\n" unless $initem; + output ", " if $initem; + $initem = 1; + s/\.$//; + s/^-X\b/-I<X>/; + output $_; next; + } + } +} + +sub path2modname { + local $_ = shift; + s/\.p(m|od)$//; + s-.*?/(lib|ext)/--; + s-/-::-g; + s/(\w+)::\1/$1/; + return $_; +} + +sub unhead2 { + if ($inhead2) { + output "\n\n=back\n\n"; + } + $inhead2 = 0; + $initem = 0; +} + +sub unitem { + if ($initem) { + output "\n\n"; + ##print "\n\n=back\n\n"; + } + $initem = 0; +} + +sub nl { + 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; + } + } +} |
