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         =head1 NAME
  45
  46         perltoc - perl documentation table of contents
  47
  48         =head1 DESCRIPTION
  49
  50         This page provides a brief table of contents for the rest of the Perl
  51         documentation set.  It is meant to be scanned quickly or grepped
  52         through to locate the proper section you're looking for.
  53
  54         =head1 BASIC DOCUMENTATION
  55
  56 EOPOD2B
  57
  58 # All the things in the master list that happen to be pod filenames
  59 foreach (grep {!$_->[2]{toc_omit}} @{$state->{master}}) {
  60     $roffitall .= "    \$mandir/$_->[0].1 \\\n";
  61     podset($_->[0], $_->[1]);
  62 }
  63
  64 foreach my $type (qw(PRAGMA MODULE)) {
  65     ($_= <<"EOPOD2B") =~ s/^\t//gm and $OUT .= $_;
  66
  67
  68
  69         =head1 $type DOCUMENTATION
  70
  71 EOPOD2B
  72
  73     foreach my $name (sort keys %{$found->{$type}}) {
  74         $roffitall .= "    \$libdir/$name.3 \\\n";
  75         podset($name, $found->{$type}{$name});
  76     }
  77 }
  78
  79 $_= <<"EOPOD2B";
  80
  81
  82         =head1 AUXILIARY DOCUMENTATION
  83
  84         Here should be listed all the extra programs' documentation, but they
  85         don't all have manual pages yet:
  86
  87         =over 4
  88
  89 EOPOD2B
  90
  91 $_ .=  join "\n", map {"\t=item $_\n"} @{$state->{aux}};
  92 $_ .= <<"EOPOD2B" ;
  93
  94         =back
  95
  96         =head1 AUTHOR
  97
  98         Larry Wall <F<larry\@wall.org>>, with the help of oodles
  99         of other folks.
 100
 101
 102 EOPOD2B
 103
 104 s/^\t//gm;
 105 $OUT .= "$_\n";
 106
 107 $OUT =~ s/\n\s+\n/\n\n/gs;
 108 $OUT =~ s/\n{3,}/\n\n/g;
 109
 110 $OUT =~ s/([^\n]+)/wrap('', '', $1)/ge;
 111
 112 write_or_die('pod/perltoc.pod', $OUT);
 113
 114 write_or_die('pod/roffitall', <<'EOH' . $roffitall . <<'EOT');
 115 #!/bin/sh
 116 #
 117 # Usage: roffitall [-nroff|-psroff|-groff]
 118 #
 119 # Authors: Tom Christiansen, Raphael Manfredi
 120
 121 me=roffitall
 122 tmp=.
 123
 124 if test -f ../config.sh; then
 125         . ../config.sh
 126 fi
 127
 128 mandir=$installman1dir
 129 libdir=$installman3dir
 130
 131 test -d $mandir || mandir=/usr/new/man/man1
 132 test -d $libdir || libdir=/usr/new/man/man3
 133
 134 case "$1" in
 135 -nroff) cmd="nroff -man"; ext='txt';;
 136 -psroff) cmd="psroff -t"; ext='ps';;
 137 -groff) cmd="groff -man"; ext='ps';;
 138 *)
 139         echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2
 140         exit 1
 141         ;;
 142 esac
 143
 144 toroff=`
 145         echo            \
 146 EOH
 147     | perl -ne 'map { -r && print "$_ " } split'`
 148
 149     # Bypass internal shell buffer limit -- can't use case
 150     if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then
 151         echo "$me: empty file list -- did you run install?" >&2
 152         exit 1
 153     fi
 154
 155     #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
 156     #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw
 157
 158     # First, create the raw data
 159     run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
 160     echo "$me: running $run"
 161     eval $run $toroff
 162
 163     #Now create the TOC
 164     echo "$me: parsing TOC"
 165     perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
 166     run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
 167     echo "$me: running $run"
 168     eval $run
 169
 170     # Finally, recreate the Doc, without the blank page 0
 171     run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
 172     echo "$me: running $run"
 173     eval $run $toroff
 174     rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
 175     echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
 176 EOT
 177
 178 exit(0);
 179
 180 # Below are all the auxiliary routines for generating perltoc.pod
 181
 182 my ($inhead1, $inhead2, $initem);
 183
 184 sub podset {
 185     my ($pod, $file) = @_;
 186
 187     open my $fh, '<', $file or my_die "Can't open file '$file' for $pod: $!";
 188
 189     local *_;
 190     my $found_pod;
 191     while (<$fh>) {
 192         if (/^=head1\s+NAME\b/) {
 193             ++$found_pod;
 194             last;
 195         }
 196     }
 197
 198     unless ($found_pod) {
 199         warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
 200         return;
 201     }
 202
 203     seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
 204     local $/ = '';
 205
 206     while(<$fh>) {
 207         tr/\015//d;
 208         if (s/^=head1 (NAME)\s*/=head2 /) {
 209             unhead1();
 210             $OUT .= "\n\n=head2 ";
 211             $_ = <$fh>;
 212             # Remove svn keyword expansions from the Perl FAQ
 213             s/ \(\$Revision: \d+ \$\)//g;
 214             if ( /^\s*\Q$pod\E\b/ ) {
 215                 s/$pod\.pm/$pod/;       # '.pm' in NAME !?
 216             } else {
 217                 s/^/$pod, /;
 218             }
 219         }
 220         elsif (s/^=head1 (.*)/=item $1/) {
 221             unhead2();
 222             $OUT .= "=over 4\n\n" unless $inhead1;
 223             $inhead1 = 1;
 224             $_ .= "\n";
 225         }
 226         elsif (s/^=head2 (.*)/=item $1/) {
 227             unitem();
 228             $OUT .= "=over 4\n\n" unless $inhead2;
 229             $inhead2 = 1;
 230             $_ .= "\n";
 231         }
 232         elsif (s/^=item ([^=].*)/$1/) {
 233             next if $pod eq 'perldiag';
 234             s/^\s*\*\s*$// && next;
 235             s/^\s*\*\s*//;
 236             s/\n/ /g;
 237             s/\s+$//;
 238             next if /^[\d.]+$/;
 239             next if $pod eq 'perlmodlib' && /^ftp:/;
 240             $OUT .= ", " if $initem;
 241             $initem = 1;
 242             s/\.$//;
 243             s/^-X\b/-I<X>/;
 244         }
 245         else {
 246             unhead1() if /^=cut\s*\n/;
 247             next;
 248         }
 249         $OUT .= $_;
 250     }
 251 }
 252
 253 sub unhead1 {
 254     unhead2();
 255     if ($inhead1) {
 256         $OUT .= "\n\n=back\n\n";
 257     }
 258     $inhead1 = 0;
 259 }
 260
 261 sub unhead2 {
 262     unitem();
 263     if ($inhead2) {
 264         $OUT .= "\n\n=back\n\n";
 265     }
 266     $inhead2 = 0;
 267 }
 268
 269 sub unitem {
 270     if ($initem) {
 271         $OUT .= "\n\n";
 272     }
 273     $initem = 0;
 274 }
 275
 276 # Local variables:
 277 # cperl-indent-level: 4
 278 # indent-tabs-mode: nil
 279 # End:
 280 #
 281 # ex: set ts=8 sts=4 sw=4 et: