| #!/usr/bin/perl -w |
| |
| use strict; |
| use vars qw($Quiet); |
| use File::Spec; |
| use FindBin; |
| use Text::Wrap; |
| use Getopt::Long; |
| |
| no locale; |
| |
| # Assumption is that we're either already being run from the top level (*nix, |
| # VMS), or have absolute paths in @INC (Win32, pod/Makefile) |
| BEGIN { |
| my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir); |
| chdir $Top or die "Can't chdir to $Top: $!"; |
| require 'Porting/pod_lib.pl'; |
| } |
| |
| die "$0: Usage: $0 [--quiet]\n" |
| unless GetOptions (quiet => \$Quiet) && !@ARGV; |
| |
| my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod'); |
| |
| my $found = pods_to_install(); |
| |
| my_die "Can't find any pods!\n" unless %$found; |
| |
| # Accumulating everything into a lexical before writing to disk dates from the |
| # time when this script also provided the functionality of regen/pod_rules.pl |
| # and this code was in a subroutine do_toc(). In turn, the use of a file scoped |
| # lexical instead of a parameter or return value is because the code dates back |
| # further still, and used *only* to create pod/perltoc.pod by printing direct |
| |
| my $OUT; |
| my $roffitall; |
| |
| ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; |
| |
| # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! |
| # This file is autogenerated by buildtoc from all the other pods. |
| # Edit those files and run $0 to effect changes. |
| |
| =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 |
| |
| # All the things in the master list that happen to be pod filenames |
| foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) { |
| $roffitall .= " \$mandir/$_->[0].1 \\\n"; |
| podset($_->[0], $_->[1]); |
| } |
| |
| foreach my $type (qw(PRAGMA MODULE)) { |
| ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_; |
| |
| |
| |
| =head1 $type DOCUMENTATION |
| |
| EOPOD2B |
| |
| foreach my $name (sort keys %{$found->{$type}}) { |
| $roffitall .= " \$libdir/$name.3 \\\n"; |
| podset($name, $found->{$type}{$name}); |
| } |
| } |
| |
| $_= <<"EOPOD2B"; |
| |
| |
| =head1 AUXILIARY DOCUMENTATION |
| |
| Here should be listed all the extra programs' documentation, but they |
| don't all have manual pages yet: |
| |
| =over 4 |
| |
| EOPOD2B |
| |
| $_ .= join "\n", map {"\t=item $_\n"} @{$state->{aux}}; |
| $_ .= <<"EOPOD2B" ; |
| |
| =back |
| |
| =head1 AUTHOR |
| |
| Larry Wall <F<larry\@wall.org>>, with the help of oodles |
| of other folks. |
| |
| |
| EOPOD2B |
| |
| s/^\t//gm; |
| $OUT .= "$_\n"; |
| |
| $OUT =~ s/\n\s+\n/\n\n/gs; |
| $OUT =~ s/\n{3,}/\n\n/g; |
| |
| $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge; |
| |
| write_or_die('pod/perltoc.pod', $OUT); |
| |
| write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT'); |
| #!/bin/sh |
| # |
| # Usage: roffitall [-nroff|-psroff|-groff] |
| # |
| # Authors: Tom Christiansen, Raphael Manfredi |
| |
| me=roffitall |
| tmp=. |
| |
| if test -f ../config.sh; then |
| . ../config.sh |
| fi |
| |
| mandir=$installman1dir |
| libdir=$installman3dir |
| |
| test -d $mandir || mandir=/usr/new/man/man1 |
| test -d $libdir || libdir=/usr/new/man/man3 |
| |
| case "$1" in |
| -nroff) cmd="nroff -man"; ext='txt';; |
| -psroff) cmd="psroff -t"; ext='ps';; |
| -groff) cmd="groff -man"; ext='ps';; |
| *) |
| echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2 |
| exit 1 |
| ;; |
| esac |
| |
| toroff=` |
| echo \ |
| EOH |
| | perl -ne 'map { -r && print "$_ " } split'` |
| |
| # Bypass internal shell buffer limit -- can't use case |
| if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then |
| echo "$me: empty file list -- did you run install?" >&2 |
| exit 1 |
| fi |
| |
| #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw |
| #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw |
| |
| # First, create the raw data |
| run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" |
| echo "$me: running $run" |
| eval $run $toroff |
| |
| #Now create the TOC |
| echo "$me: parsing TOC" |
| perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man |
| run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" |
| echo "$me: running $run" |
| eval $run |
| |
| # Finally, recreate the Doc, without the blank page 0 |
| run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" |
| echo "$me: running $run" |
| eval $run $toroff |
| rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw |
| echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" |
| EOT |
| |
| exit(0); |
| |
| # Below are all the auxiliary routines for generating perltoc.pod |
| |
| my ($inhead1, $inhead2, $initem); |
| |
| sub podset { |
| my ($pod, $file) = @_; |
| |
| open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!"; |
| |
| local *_; |
| my $found_pod; |
| while (<$fh>) { |
| if (/^=head1\s+NAME\b/) { |
| ++$found_pod; |
| last; |
| } |
| } |
| |
| unless ($found_pod) { |
| warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet; |
| return; |
| } |
| |
| seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!"; |
| local $/ = ''; |
| |
| while(<$fh>) { |
| tr/\015//d; |
| if (s/^=head1 (NAME)\s*/=head2 /) { |
| unhead1(); |
| $OUT .= "\n\n=head2 "; |
| $_ = <$fh>; |
| # Remove svn keyword expansions from the Perl FAQ |
| s/ \(\$Revision: \d+ \$\)//g; |
| if ( /^\s*\Q$pod\E\b/ ) { |
| s/$pod\.pm/$pod/; # '.pm' in NAME !? |
| } else { |
| s/^/$pod, /; |
| } |
| } |
| elsif (s/^=head1 (.*)/=item $1/) { |
| unhead2(); |
| $OUT .= "=over 4\n\n" unless $inhead1; |
| $inhead1 = 1; |
| $_ .= "\n"; |
| } |
| elsif (s/^=head2 (.*)/=item $1/) { |
| unitem(); |
| $OUT .= "=over 4\n\n" unless $inhead2; |
| $inhead2 = 1; |
| $_ .= "\n"; |
| } |
| elsif (s/^=item ([^=].*)/$1/) { |
| next if $pod eq 'perldiag'; |
| s/^\s*\*\s*$// && next; |
| s/^\s*\*\s*//; |
| s/\n/ /g; |
| s/\s+$//; |
| next if /^[\d.]+$/; |
| next if $pod eq 'perlmodlib' && /^ftp:/; |
| $OUT .= ", " if $initem; |
| $initem = 1; |
| s/\.$//; |
| s/^-X\b/-I<X>/; |
| } |
| else { |
| unhead1() if /^=cut\s*\n/; |
| next; |
| } |
| $OUT .= $_; |
| } |
| } |
| |
| sub unhead1 { |
| unhead2(); |
| if ($inhead1) { |
| $OUT .= "\n\n=back\n\n"; |
| } |
| $inhead1 = 0; |
| } |
| |
| sub unhead2 { |
| unitem(); |
| if ($inhead2) { |
| $OUT .= "\n\n=back\n\n"; |
| } |
| $inhead2 = 0; |
| } |
| |
| sub unitem { |
| if ($initem) { |
| $OUT .= "\n\n"; |
| } |
| $initem = 0; |
| } |
| |
| # Local variables: |
| # cperl-indent-level: 4 |
| # indent-tabs-mode: nil |
| # End: |
| # |
| # ex: set ts=8 sts=4 sw=4 et: |