pod/buildtoc

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw($Quiet);
   5 use File::Spec;
   6 use FindBin;
   7 use Text::Wrap;
   8 use Getopt::Long;
   9
  10 no locale;
  11
  12 # Assumption is that we're either already being run from the top level (*nix,
  13 # VMS), or have absolute paths in @INC (Win32, pod/Makefile)
  14 BEGIN {
  15   my $Top = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
  16   chdir $Top or die "Can't chdir to $Top: $!";
  17   require 'Porting/pod_lib.pl';
  18 }
  19
  20 die "$0: Usage: $0 [--quiet]\n"
  21     unless GetOptions (quiet => \$Quiet) && !@ARGV;
  22
  23 my $state = get_pod_metadata(0, sub { warn @_ if @_ }, 'pod/perltoc.pod');
  24
  25 my $found = pods_to_install();
  26
  27 my_die "Can't find any pods!\n" unless %$found;
  28
  29 # Accumulating everything into a lexical before writing to disk dates from the
  30 # time when this script also provided the functionality of regen/pod_rules.pl
  31 # and this code was in a subroutine do_toc(). In turn, the use of a file scoped
  32 # lexical instead of a parameter or return value is because the code dates back
  33 # further still, and used *only* to create pod/perltoc.pod by printing direct
  34
  35 my $OUT;
  36 my $roffitall;
  37
  38 ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
  39
  40         # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  41         # This file is autogenerated by buildtoc from all the other pods.
  42         # Edit those files and run $0 to effect changes.
  43
  44         =encoding UTF-8
  45
  46         =head1 NAME
  47
  48         perltoc - perl documentation table of contents
  49
  50         =head1 DESCRIPTION
  51
  52         This page provides a brief table of contents for the rest of the Perl
  53         documentation set.  It is meant to be scanned quickly or grepped
  54         through to locate the proper section you're looking for.
  55
  56         =head1 BASIC DOCUMENTATION
  57
  58 EOPOD2B
  59
  60 # All the things in the master list that happen to be pod filenames
  61 foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
  62     $roffitall .= "    \$mandir/$_->[0].1 \\\n";
  63     podset($_->[0], $_->[1]);
  64 }
  65
  66 foreach my $type (qw(PRAGMA MODULE)) {
  67     ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
  68
  69
  70
  71         =head1 $type DOCUMENTATION
  72
  73 EOPOD2B
  74
  75     foreach my $name (sort keys %{$found->{$type}}) {
  76         $roffitall .= "    \$libdir/$name.3 \\\n";
  77         podset($name, $found->{$type}{$name});
  78     }
  79 }
  80
  81 $_= <<"EOPOD2B";
  82
  83
  84         =head1 AUXILIARY DOCUMENTATION
  85
  86         Here should be listed all the extra programs' documentation, but they
  87         don't all have manual pages yet:
  88
  89         =over 4
  90
  91 EOPOD2B
  92
  93 $_ .=  join "\n", map {"\t=item $_\n"} @{$state->{aux}};
  94 $_ .= <<"EOPOD2B" ;
  95
  96         =back
  97
  98         =head1 AUTHOR
  99
 100         Larry Wall <F<larry\@wall.org>>, with the help of oodles
 101         of other folks.
 102
 103
 104 EOPOD2B
 105
 106 s/^\t//gm;
 107 $OUT .= "$_\n";
 108
 109 $OUT =~ s/\n\s+\n/\n\n/gs;
 110 $OUT =~ s/\n{3,}/\n\n/g;
 111
 112 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
 113
 114 write_or_die('pod/perltoc.pod', $OUT);
 115
 116 write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT');
 117 #!/bin/sh
 118 #
 119 # Usage: roffitall [-nroff|-psroff|-groff]
 120 #
 121 # Authors: Tom Christiansen, Raphael Manfredi
 122
 123 me=roffitall
 124 tmp=.
 125
 126 if test -f ../config.sh; then
 127         . ../config.sh
 128 fi
 129
 130 mandir=$installman1dir
 131 libdir=$installman3dir
 132
 133 test -d $mandir || mandir=/usr/new/man/man1
 134 test -d $libdir || libdir=/usr/new/man/man3
 135
 136 case "$1" in
 137 -nroff) cmd="nroff -man"; ext='txt';;
 138 -psroff) cmd="psroff -t"; ext='ps';;
 139 -groff) cmd="groff -man"; ext='ps';;
 140 *)
 141         echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2
 142         exit 1
 143         ;;
 144 esac
 145
 146 toroff=`
 147         echo            \
 148 EOH
 149     | perl -ne 'map { -r && print "$_ " } split'`
 150
 151     # Bypass internal shell buffer limit -- can't use case
 152     if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
 153         echo "$me: empty file list -- did you run install?" >&2
 154         exit 1
 155     fi
 156
 157     #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
 158     #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
 159
 160     # First, create the raw data
 161     run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
 162     echo "$me: running $run"
 163     eval $run $toroff
 164
 165     #Now create the TOC
 166     echo "$me: parsing TOC"
 167     perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
 168     run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
 169     echo "$me: running $run"
 170     eval $run
 171
 172     # Finally, recreate the Doc, without the blank page 0
 173     run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
 174     echo "$me: running $run"
 175     eval $run $toroff
 176     rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
 177     echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
 178 EOT
 179
 180 exit(0);
 181
 182 # Below are all the auxiliary routines for generating perltoc.pod
 183
 184 my ($inhead1, $inhead2, $initem);
 185
 186 sub podset {
 187     my ($pod, $file) = @_;
 188
 189     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
 190
 191     local *_;
 192     my $found_pod;
 193     while (<$fh>) {
 194         if (/^=head1\s+NAME\b/) {
 195             ++$found_pod;
 196             last;
 197         }
 198     }
 199
 200     unless ($found_pod) {
 201         warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
 202         return;
 203     }
 204
 205     seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
 206     local $/ = '';
 207
 208     while(<$fh>) {
 209         tr/\015//d;
 210         if (s/^=head1 (NAME)\s*/=head2 /) {
 211             unhead1();
 212             $OUT .= "\n\n=head2 ";
 213             $_ = <$fh>;
 214             # Remove svn keyword expansions from the Perl FAQ
 215             s/ \(\$Revision: \d+ \$\)//g;
 216             if ( /^\s*\Q$pod\E\b/ ) {
 217                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 218             } else {
 219                 s/^/$pod, /;
 220             }
 221         }
 222         elsif (s/^=head1 (.*)/=item $1/) {
 223             unhead2();
 224             $OUT .= "=over 4\n\n" unless $inhead1;
 225             $inhead1 = 1;
 226             $_ .= "\n";
 227         }
 228         elsif (s/^=head2 (.*)/=item $1/) {
 229             unitem();
 230             $OUT .= "=over 4\n\n" unless $inhead2;
 231             $inhead2 = 1;
 232             $_ .= "\n";
 233         }
 234         elsif (s/^=item ([^=].*)/$1/) {
 235             next if $pod eq 'perldiag';
 236             s/^\s*\*\s*$// && next;
 237             s/^\s*\*\s*//;
 238             s/\n/ /g;
 239             s/\s+$//;
 240             next if /^[\d.]+$/;
 241             next if $pod eq 'perlmodlib' && /^ftp:/;
 242             $OUT .= ", " if $initem;
 243             $initem = 1;
 244             s/\.$//;
 245             s/^-X\b/-I<X>/;
 246         }
 247         else {
 248             unhead1() if /^=cut\s*\n/;
 249             next;
 250         }
 251         $OUT .= $_;
 252     }
 253 }
 254
 255 sub unhead1 {
 256     unhead2();
 257     if ($inhead1) {
 258         $OUT .= "\n\n=back\n\n";
 259     }
 260     $inhead1 = 0;
 261 }
 262
 263 sub unhead2 {
 264     unitem();
 265     if ($inhead2) {
 266         $OUT .= "\n\n=back\n\n";
 267     }
 268     $inhead2 = 0;
 269 }
 270
 271 sub unitem {
 272     if ($initem) {
 273         $OUT .= "\n\n";
 274     }
 275     $initem = 0;
 276 }
 277
 278 # Local variables:
 279 # cperl-indent-level: 4
 280 # indent-tabs-mode: nil
 281 # End:
 282 #
 283 # ex: set ts=8 sts=4 sw=4 et: