pod/buildtoc

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